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
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!
Dick, the code’s not firing for me for some reason. Haven’t tried to diagnose yet.
Rerun Auto_Open. You probably lost scope on gclsApp because you were fiddling around in the code.
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.
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.Nice use of AlternativeText.