What columns are filtered?
July 13, 2010 • JP • 2 Comments • Rate This Article
• Links to this article

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.
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.
↑ Scroll to topPrevious Post: Adding vacation days to Outlook in bulk from Excel
Next Post: Which macro shortcut keys do you use?



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.
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 Sub
Nice approach!