You knew I wasn’t going to let this go, didn’t you?
I started with snb’s rewrite. I really don’t want to use the SelectionChange event. It runs whenever you move around the spreadsheet and that’s just wasteful. I like how snb did the heavy lifting on SheetActivate, then only burns processors when you change a cell. I probably still need some error checking (and by probably I mean definitely) but here’s what I have so far.
|
1 2 3 4 5 6 7 |
Public gclsApp As CApp Public Sub Auto_Open() Set gclsApp = New CApp End Sub |
Why do I always create my event class and then set the App property equal to the Excel.Application? Why not just do that in the class Initialize event? Stay tuned.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
Private WithEvents mclsApp As Application Private Const msDELIM As String = "||" Public Property Set App(ByVal clsApp As Application): Set mclsApp = clsApp: End Property Public Property Get App() As Application: Set App = mclsApp: End Property Private Sub Class_Initialize() Set mclsApp = Application If Not ActiveSheet Is Nothing Then mclsApp_SheetActivate ActiveSheet End If End Sub |
I got rid of the OldValue property as I’m using snb’s method. I added a constant delimeter that I’ll never use in a table header. Then I set my application right in the Initialize event, which I should have been doing all along. Finally, I need to load up the AlternativeText for any sheets just in case it’s not done yet.
|
1 2 3 4 5 6 7 8 9 10 11 |
Private Sub mclsApp_SheetActivate(ByVal Sh As Object) Dim lo As ListObject If Sh.Type = xlWorksheet Then For Each lo In Sh.ListObjects lo.AlternativeText = Join(Application.Index(lo.HeaderRowRange.Value, 1, 0), msDELIM) Next lo End If End Sub |
This is right out of snb’s code. Join the header into a big string separated by double pipe, then stick it in the AlternativeText property for safe keeping.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
Private Sub mclsApp_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim lo As ListObject Dim rLoHeader As Range Dim sHeader As String 'See if the target is in the header of a listobject On Error Resume Next Set rLoHeader = Nothing Set rLoHeader = Intersect(Target, Target.ListObject.HeaderRowRange) On Error GoTo 0 Application.EnableEvents = False If Not rLoHeader Is Nothing Then Set lo = Target.ListObject 'if the user starts the entry with two spaces, they want to change the header 'so don't fire the code, just change the header sans the spaces If Left$(Target.Value, 2) = Space(2) Then sHeader = Mid$(Target.Value, 3, Len(Target.Value)) Else 'Filter based on the value typed sHeader = Split(lo.AlternativeText, msDELIM)(Target.Column - lo.Range.Columns(1).Column) 'I ran into that code firing twice problem when I changed this line. I brute forced the 'sucker by seeing if the Target.Value is the same as the header. If Target.Value <> sHeader Then 'If the user enters more than one value separated by a space, it will filter on all those 'values. lo.Range.AutoFilter lo.ListColumns(Target.Value).Index, Split(Target.Value), xlFilterValues End If End If Target.Value = sHeader End If Application.EnableEvents = True End Sub |
First I make sure that the cell being changed is in the header of a ListObject (Excel Table in UI speak). This will disastrously fail (I assume) if you change two cells at once.
Next I added some code that will allow me to actually change the header if I want to. If I precede the entry by two spaces, the code will assume I want to change the header and not filter. Then it removes the two spaces and changes the header without filtering. If I type
|
1 |
{Space}{Space}MyDate |
in the Date field, it will change the header to MyDate and not filter.
Joe commented that you could separate values with a comma to filter on more than on thing. Good idea. I like spaces better, so instead of filtering on Target.Value, I pass the AutoFilter method an array and use xlFilterValues. The Split function produces an array by splitting a String on space.
When I made this change to the AutoFilter method, I ran into my old friend double-event-trigger-for-damn-reason. I beat that problem over the head by checking if the search term was the same as the header – a characteristic of the second bullshit trigger. This introduces a bug when you want to filter the State field on the word “State”. Nothing will happen. I don’t care. I’m done with that problem.
It’s working awesomely and I’m about ready to put it in the PMW to give some real-life test.
One more thing. If you want to filter on partial names you have to include an asterisk. Entering
|
1 |
Col* Ala* |
will give you Colorado and Alaska (from my Sample data – Alabama didn’t make the cut, I guess). If you type
|
1 |
*hi* |
, you’ll get Ohio, New Hampshire, and Washington.
OK, really the last thing. If you want to filter on dates by typing multiple dates, you have to type the full year.
You can download BetterAutoFilter.zip
How ’bout an easy way to clear the filter, using Delete or something? I know you can use Alt + Down Arrow then C, but I really think you should stop at nothing until you have an even more better even more better Autofilter.
Good idea.
Be wary of the Application.EnableEvents – I believe that it is not reset if an error occurs – which can have unexpected results later on – so make sure the error handling forces it back on. And it is good practice to keep the enable/disable as close as possible to the line of code that you want to protect – which I think is just the Target.value = sHeader – that way unexpected errors will not accidentally leave it off
–Charlie