ListBox Filter With Wildcards and Unique Values

Posted on by

This post demonstrates a simple setup to filter a userform listbox as you type into a textbox. The filter uses VBA’s Like operator to pick up matches anywhere within the string. For example, typing “ursumb” matches to “yousumbuddy.” The Like operator allows wildcards, so “/*/201?” matches all dates from 2010 onwards. Like is also case-sensitive, so it can filter by case, or not, as specified. In addition the code uses the tried and true Collection method to allow filtering by unique items.

So, with this list of most popular US girls’ names for 2012 (modified in favor of “Emily”) you can filter and then add Unique and Case Sensitive filters. Note that clicking a name takes you to that row in the table:

listbox filter

Nice, isn’t it? Here’s the main routine, which gets called whenever the text in the filter textbox changes or one of the checkboxes is clicked:

Sub ResetFilter()
Dim rngTableCol As Excel.Range
Dim varTableCol As Variant
Dim RowCount As Long
Dim collUnique As Collection
Dim FilteredRows() As String
Dim i As Long
Dim ArrCount As Long
Dim FilterPattern As String
Dim UniqueValuesOnly As Boolean
Dim UniqueConstraint As Boolean
Dim CaseSensitive As Boolean

'the asterisks make it match anywhere within the string
FilterPattern = "*" & Me.txtFilter.Text & "*"
UniqueValuesOnly = Me.chkUnique.Value
CaseSensitive = Me.chkCaseSensitive

'used only if UniqueValuesOnly is true
Set collUnique = New Collection
Set rngTableCol = loActive.ListColumns(1).DataBodyRange
'note that Transpose won't work with > 65536 rows
varTableCol = Application.WorksheetFunction.Transpose(rngTableCol.Value)
RowCount = UBound(varTableCol)
ReDim FilteredRows(1 To 2, 1 To RowCount)
For i = 1 To RowCount
    If UniqueValuesOnly Then
        On Error Resume Next
        'reset for this loop iteration
        UniqueConstraint = False
        'Add fails if key isn't UniqueValuesOnly
        collUnique.Add Item:="test", Key:=CStr(varTableCol(i))
        If Err.Number <> 0 Then
            UniqueConstraint = True
        End If
        On Error GoTo 0
    End If
    'True if UniqueValuesOnly is false or if
    'UniqueValuesOnly is True and this is the
    'first occurrence of the item
    If Not UniqueConstraint Then
        'Like operator is case sensitive,
        'so need to use LCase if not CaseSensitive
        If (Not CaseSensitive And LCase(varTableCol(i)) Like LCase(FilterPattern)) _
           Or (CaseSensitive And varTableCol(i) Like FilterPattern) Then
            'add to array if ListBox item matches filter
            ArrCount = ArrCount + 1
            'there's a hidden ListBox column that stores the record num
            FilteredRows(1, ArrCount) = i
            FilteredRows(2, ArrCount) = varTableCol(i)
        End If
    End If
Next i
If ArrCount > 0 Then
    'delete empty array items
    'a ListBox cannot contain more than 65536 items
    ReDim Preserve FilteredRows(1 To 2, 1 To Application.WorksheetFunction.Min(ArrCount, 65536))
Else
    're-initialize the array
    Erase FilteredRows
End If
If ArrCount > 1 Then
    Me.lstDetail.List = Application.WorksheetFunction.Transpose(FilteredRows)
Else
    Me.lstDetail.Clear
    'have to add separately if just one match
    'or we get two rows, not two columns, in ListBox
    If ArrCount = 1 Then
        Me.lstDetail.AddItem FilteredRows(1, 1)
        Me.lstDetail.List(0, 1) = FilteredRows(2, 1)
    End If
End If
End Sub

This routine takes advantage of the fact that Collection keys must be unique. If “Unique” is checked on the form, we test each value before adding it to the ListBox’s array.

The FilterPattern string has asterisks at the beginning and end. This is why the filter matches if it’s found anywhere within a table item.

In addition to the girl’s name, an array item also holds the record number for that name. This is used in another subroutine that activates the table row when the listbox selection changes:

Private Sub lstDetail_Change()
GoToRow
End Sub

Sub GoToRow()
If Me.lstDetail.ListCount > 0 Then
    Application.Goto loActive.ListRows(Me.lstDetail.Value).Range.Cells(1), True
End If
End Sub

Here’s how it looks when filtering dates:

filtered dates

The speed is quite reasonable for tables with less than 10,000 items. Above that it gets slow, but is still usable all the way up to the limit of 65,536 listbox items. Yikes!

Here’s a workbook with all the code and the name and date tables to fool around with.

An Invitation

I’ve expanded this concept into a full-fledged Table Viewer. I’ve been using it in its alpha state and it’s quite handy for zipping around a big table. Along with the features here, it handles multiple columns, allows you to view only visible rows, and some other stuff. If anybody is interested in testing it out, leave a comment here or use the contact form.

23 thoughts on “ListBox Filter With Wildcards and Unique Values”

  1. This filter reminds me of my “Scribble Filter” (based off of Advanced Filter) I created. I like how your filter is simple and elegant. Mine is a bit complicated and I created part of it incorrectly so I need to go back and rework it sometime (I built part of it from scratch making it much more complicated than need be).

    Reply ↓

  4. The routine is working brilliantly, but after several attempts I was unable to adjust to my listbox1 (and not to WorkSheet) that has five columns. Perhaps you can help me;…

    Reply ↓

      • Thank you very much, but I think I did it. From your code I kept only the * idea and worked with a second auxiliary variable size list, hiding the first, with content only what we found …. End result, I can find what I want to all of 5 columns of my list, and displays him . If you want, I just adjust the code to general, and I will send him here. soon

        Reply ↓

  5. Really useful bit of code, thanks for this! 🙂 Quick question, I am trying to implement this into a workbook I am currently developing, however my data table would have multiple columns and I would like to filter all of them and show any matching entries in the list box. Is this possible using your code as a base?

    Thanks in advance! 🙂

    Reply ↓

  6. In excel 2003 the line:
    Set rngTableCol = loActive.ListColumns(1).DataBodyRange

    return error 438 “object doesn’t support this property or method”

    Reply ↓

    • Nick, that’s true. Tables/ListObjects received a major upgrade in Excel 2007, including the addition of the ListColumns.DataBodyRange propertty. (I tried to indicate that by tagging the post 200710/13). It’s been long enough now since I’ve worked with 2003 that I had to look this up to confirm.

      Reply ↓

  7. Hi, Can you help? I work in an internal post room and trying to make a form to help us know where to insert peoples post and so I have made a spread sheet that holds people names, internal box number, telephone number and other columns. Is there a way to display the other columns as this filters so I can see the results and know more details? Please help. I’ve been trying for ages to do this and can see that the filter search is going to work best as some names a spelt differently and can wild card search to find similar spelling names.

    Reply ↓

    • Hi Chris. I’m afraid I’m not able to help with this. I suggest asking the question at Stack Overflow or another forum. Show them a simple example of your current sheet and any code you’ve got so far. Good luck!

      Reply ↓

  8. Hi Doug. Great itea, this. Couple of thoughts:
    1.I’m pretty sure this Max should be a Min:

    delete empty array items
       'a ListBox cannot contain more than 65536 items
       ReDim Preserve FilteredRows(1 To 2, 1 To Application.WorksheetFunction.Max(ArrCount, 65536))

    2. The behavior of the Like operator depends on the module-wide Option Compare statement. The default string-comparison method for each module is Option Compare Binary, which is case sensitive. Option Compare Text is case insensitive. This gives one possible way to speed up your code: conditionally call dedicated ‘Like_CaseSensitive’ or ‘Like_CaseInsensitive’ routines stored in separate modules. You’d have to use application.run for this, I think. But rather than go to those extremes, I’d suggest breaking the following down into nested IF statements, so that only the ones relevant to the branch get executed:

    If (Not CaseSensitive And LCase(varTableCol(i)) Like LCase(FilterPattern)) _
               Or (CaseSensitive And varTableCol(i) Like FilterPattern) Then

    3. Rather than this:

    For i = 1 To RowCount
        If UniqueValuesOnly Then

    …I’d suggest this:

    If UniqueValuesOnly Then
        On Error Resume Next
        'Code that iterates through the data, and adds items to a dictionary
        On Error GoTo 0
         'Code that writes dictionary keys (which will be unique) to a variant array.
    Else
        'Suck the non-unique values direct to a variant array
    end if

    That way, you avoid having to do a whole lot of checks (such as the If UniqueValuesOnly Then check).

    4. It would be interesting to look at either letting the user determine when to refresh the matching terms (perhaps after they push Enter), and reusing whatever is the dictionary/collection from the last run as a ‘starting point’ in the event that a user is adding one more character to a string. For instance, if they were typing out “Alice”, then currently the code runs after the addition of each letter, and each time it runs on the entire table of data. But if you think about it, every time they add a letter to either end of the search term, you only need to use the subset of data in the dictionary/collection from the last pass, rather than start searching for matches from scratch.

    I’ll have a crack at coding something up when I get a moment.

    Reply ↓

  9. Forgot something: Dictionaries can be either case sensitive OR case insensitive. Collections are case insensitive bastards. Steer clear of the unhelpful sods, is my advice. Just use late-bound Dictionaries. Indeed, you can see this in your example spreadsheet if you add say ‘sophia’ to the 2nd row: only ‘Sophia’ shows up in the Userform when you run the code, and you cannot use the Userform to select ‘sophia.

    It’s well worth checking out one of my favorite ever VBA articles for more on Dictionaries vs Collections:
    http://www.experts-exchange.com/articles/3391/Using-the-Dictionary-Class-in-VBA.html
    …particularly Example #2: Distinct Values with Case-Sensitive Keys

    And then there’s my 2nd favorite article, which I know you’ve already seen:
    http://dailydoseofexcel.com/archives/2013/10/23/dictionaries-can-be-rude/

    Reply ↓

    • Jeff, thanks for catching the MIn/Max error. It’s fixed here in the post and in the download.

      It looks like the Sophia/sophia case sensitivity problem is actually due to the code that determines uniqueness. If you uncheck the unique button the case sensitivity settings work.

      Reply ↓

      • Correct. It’s because you’re using a collection to check for uniqueness, and collections aren’t case sensitive. Dictionaries are.

        I’ve just used your general approach to produce a much better way for users to select from Data Validation lists. Very inspiring post, this.

        Reply ↓

  10. Very useful thank you 🙂 Worked it into my already existing form to make finding numbers easier. Also thanks to Jeff in the comments for the max/min comment, I was looking at that section trying to work out what was the mistake as it kept adding a silly amount of rows! So simple, I should have seen it sooner 🙂

    Reply ↓

Speak Your Mind

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

To post code, do this: <code> your vba here </code>