A Better AutoFilter

Jeff recently wrote about how you can type your filter criterion in a Pivot Table’s page field and it will filter it automagically. That’s awesome. I want the same thing when I filter Tables, so I started doing some experiments. To filter a table, you select the header, press Alt+{DOWN}, e to get to the search box, and type the search term.

Press Enter

I want to type ‘Colorado’ right in the header and have it filter.

VoilĂ 

How did I accomplish that magic? First I created a class module call CApp. It will be used to house my application level events. Up in the declarations section of CApp, I have this

Private WithEvents mclsApp As Application
Private msOldValue As String

Public Property Let OldValue(ByVal sOldValue As String): msOldValue = sOldValue: End Property
Public Property Get OldValue() As String: OldValue = msOldValue: End Property
Public Property Set App(ByVal clsApp As Application): Set mclsApp = clsApp: End Property
Public Property Get App() As Application: Set App = mclsApp: End Property

The mclsApp variable is declared WithEvents so that VBA exposes all the events of the Application object to me in this module. I’ll be using two of those events, SelectionChange and Change, to determine when to filter. The OldValue variable will hold the header that I’m overtyping so I can put it back. For instance, when I replace State (the column heading) with Colorado (the search term), I need to put the heading back to State.

To capture that old header value, I use the SheetSelectionChange event. Whenever the selection changes, this procedure is run.

Private Sub mclsApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim rLoHeader As Range

'See if the target is in the header of a listobject
On Error Resume Next
Set rLoHeader = Intersect(Target, Target.ListObject.HeaderRowRange)
On Error GoTo 0

'If it's in a header, save the header's column heading
If Not rLoHeader Is Nothing Then
Me.OldValue = Target.Value
Else
'Otherwise, clear the old value
Me.OldValue = vbNullString
End If

End Sub

If I’ve select a cell that’s in the header of a ListObject (that’s what VBA calls a Table), then save the value. This is just some test code. It needs far more error proofing, such as making sure only one cell is selected.

Next I use the SheetChange event to monitor if I type a new value in that header. First I disable events so that when I put the old header value back, it doesn’t think I’m trying to filter again.

Private Sub mclsApp_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim sFilter As String

Application.EnableEvents = False

If Len(Me.OldValue) > 0 Then
'Save the search term for later filtering
sFilter = Target.Value
'Change the header value back
Target.Value = Me.OldValue
'This shouldn't be necessary, but read on
Me.OldValue = vbNullString

'Filter based on the value typed
Target.ListObject.Range.AutoFilter Target.ListObject.ListColumns(Target.Value).Index, sFilter

End If

Application.EnableEvents = True

End Sub

I really don’t mind using the built-in autofilter string of keystrokes when I’m filtering on a string or a number. But dates? That’s another story. I hate autofiltering on dates. If I want to filter the above list on June 22nd, the keystrokes are: Alt+{DOWN}, e, {TAB}{TAB}, {SPACE} to uncheck Select All, {DOWN}{DOWN}{RIGHT} to expand June, 2 2 {SPACE} to get to the second entry that starts with a ‘2’ and check it, {ENTER}.

Stupid. I should be able to get to the search box and type 6/22 and have it filter. But it doesn’t. I though this method would make filtering on dates much better. And I was right.

Did you happen to see the comment in the above code about a particular line not being necessary? I didn’t want to remove OldValue in the SheetChange event because that’s the job of the SheetSelectionChange event. I shouldn’t need to do it. I didn’t need to do it for filtering on strings, but without it, I can’t filter on numbers or dates. For some reason that I couldn’t figure out, the SheetChange event was being called twice. The first time it would filter on ‘6/22/2014’ as expected. Then it would run again (even though I clearly have turned off events) and would filter on ‘Date’ (the column header), which, of course, it can’t find in a column of actual dates.

I even tried to make my own event enabler/disabler, but it didn’t matter. Once I set OldValue to vbNullString, filtering on numbers and dates started working. The event procedure still gets called twice, but it doesn’t try to filter because OldValue isn’t there anymore.

That leaves a potential problem. If I type, say, “Montana” in B1 and enter using Ctrl+Enter rather than just Enter, the selection doesn’t change and OldValue is blank. Now, before selecting any other cells, if I type ‘Colorado’, nothing happens. That’s not a big problem for me because I have my options set to go down on enter and wouldn’t really use Ctrl+Enter in that case. But that doesn’t mean I like it. I don’t.

This hasn’t made it into my PMW yet, but I’d like to see where it can go.

You can download BetterAutoFilter.zip

7 thoughts on “A Better AutoFilter

  1. Very cool functionality Dick! There are a lot of possibilities with this one. It might be cool if you could filter on multiple criteria by separating the filter criteria with commas. For example, typing “Colorado,Alaska” in the header would filter for both values. Although that would get ugly if the column values contained commas. Maybe line breaks (alt+enter) instead.

    You’ve definitely got me thinking… :-) Thanks for sharing!

  2. Good idea Joe. Maybe separate by a pipe instead of a comma and just accept the error if there’s a pipe in the data.

  3. I tried to imitate your goal and came up with:

    Private Sub Worksheet_Activate()
        For Each it In ListObjects
           it.AlternativeText = Join(Application.Index(it.HeaderRowRange.Value, 1, 0), "_")
        Next
    End Sub
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        For Each it In ListObjects
            If Not Intersect(Target, it.HeaderRowRange) Is Nothing Then
                Application.EnableEvents = False
                
                If Target.Value  Split(it.AlternativeText, "_")(Target.Column - it.Range.Columns(1).Column) Then
                    it.Range.AutoFilter Target.Column - it.Range.Columns(1).Column + 1, Target.Value
                    Target = Split(it.AlternativeText, "_")(Target.Column - it.Range.Columns(1).Column)
                End If
                
                Exit For
            End If
        Next
        Application.EnableEvents = True
    End Sub
    
    I also had to add a line to prevent the code from firing twice.

Leave a Reply

Your email address will not be published. Required fields are marked *