Ever set up a monster spreadsheet with dozens of columns, then autofilter it, then forget which columns are autofiltered?
The little autofilter arrows turn blue when a filter is applied, but who wants to lose their eyesight scrolling across a worksheet looking for which ones are in effect?
I don't. So I came up with this little script that tells you which autofilter columns are actually in effect.
Sub CheckFilter()
Dim wksht As Excel.Worksheet
Dim autofilt As Excel.AutoFilter
Dim autofiltRange As Excel.Range
Dim offsetRange As Excel.Range
Dim flt As Excel.Filters
Dim msg As String
Dim i As Long
Set wksht = ActiveSheet
If wksht.FilterMode Then
Set flt = wksht.AutoFilter.Filters
For i = 1 To flt.count
' if Filter is activated, get range name
If flt.item(i).On Then
' Filter parent is AutoFilter Object
Set autofilt = flt.item(i).Parent
Set autofiltRange = autofilt.Range
Set offsetRange = autofiltRange.Resize(1, 1).Offset(, i - 1)
msg = msg & Range(offsetRange.Address).value & vbCrLf
End If
Next i
MsgBox wksht.Name & " in " & wksht.Parent.Name & _
" is filtered on the following columns: " & vbCrLf & msg
Else
MsgBox "Worksheet is not filtered."
End If
End Sub
I put this baby in my PERSONAL.XLS and when I run it, I get a popup telling me which column headers have the autofilter applied. Sweet! It's my giggle moment.
About JP
2 Comments:
I used to have to maintain a large workbook that was pretty much always filtered in one way or another and figuring out which of the 40-odd columns was filtered at any one time was a nightmare.
Rather than get a messagebox, I used the following, called from the Worksheet_SelectionChange event, so that the affected columns were always highlighted.
Sub ColorDisplayFilter() Dim flt As Filter Dim lCol As Long Dim lRow As Long Application.ScreenUpdating = False lRow = ActiveSheet.AutoFilter.Range.row Application.EnableEvents = False For Each flt In ActiveSheet.AutoFilter.Filters lCol = lCol + 1 If flt.On Then Cells(lRow, lCol).Interior.Color = vbRed Cells(lRow, lCol).Font.Color = vbWhite Else Cells(lRow, lCol).Interior.Color = 16758883 Cells(lRow, lCol).Font.Color = vbBlack End If Next flt Application.EnableEvents = True Application.ScreenUpdating = True End SubNice approach!