Search code examples
vbafiltertextboxlistbox

VBA realtime filter Listbox through Textbox


I would like to filter a Listbox created from a list of values stored in a worksheet depending on text written in a textbox contained in the same userform.

My Listbox has 4 or 5 columns (depending on OptionField selection) and I would like to search all the columns for the text written.

Example: I write "aaa" in TextField and the Listbox should return a list based on all the lines whose column 1 or 2 or 3 or 4 or 5 contain "aaa".

Below my code to refresh the list on OptionField selection (this code does not produce any error, it is just to show how I create my list):

Sub RefreshList()

Dim selcell, firstcell As String
Dim k, i As Integer
Dim r as long
i = 0
k = 0

' reads parameters from hidden worksheet

If Me.new_schl = True Then

    firstcell = Cells(3, 4).Address
    selcell = firstcell

    Do Until IsEmpty(Range("" & selcell & "")) And i = 2
        If IsEmpty(Range("" & selcell & "")) Then i = i + 1
        k = k + 1
        selcell = Cells(1 + k, 7).Address(0, 0)
    Loop

        k = k - 1
        selcell = Cells(1 + k, 7).Address(0, 0)

    With Me.ListBox1

        .ColumnCount = 4
        .ColumnWidths = "50; 80; 160; 40"
        .RowSource = ""
        Set MyData = Range("" & firstcell & ":" & selcell & "")
        .List = MyData.Cells.Value

        For r = .ListCount - 1 To 0 Step -1
            If .List(r, 3) = "" Or .List(r, 3) = "0" Then
                .RemoveItem r
            End If
        Next r

    End With

Else

    firstcell = Cells(3, 11).Address
    selcell = firstcell

    Do Until IsEmpty(Range("" & selcell & "")) And i = 11
        If IsEmpty(Range("" & selcell & "")) Then i = i + 1
        k = k + 1
        selcell = Cells(1 + k, 15).Address(0, 0)
    Loop

        k = k - 1
        selcell = Cells(1 + k, 15).Address(0, 0)

    With Me.ListBox1

        .ColumnCount = 5
        .ColumnWidths = "40; 40; 160; 40; 40"
        .RowSource = ""
        Set MyData = Range("" & firstcell & ":" & selcell & "")
        .List = MyData.Cells.Value

        For r = .ListCount - 1 To 0 Step -1
            If .List(r, 3) = "" Or .List(r, 3) = "0" Then
                .RemoveItem r
            End If
        Next r

    End With

End If

End Sub

Solution

  • Finally I could come out with something!

    Sub Filter_Change()
    
    Dim i As Long
    Dim Str As String
    
    Str = Me.Filter.Text
    
    Me.RefreshList
    
    If Not Str = "" Then
        With Me.ListBox1
    
            For i = .ListCount - 1 To 0 Step -1
                If InStr(1, LCase(.List(i, 0)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 1)), LCase(Str)) = 0 And _
                  InStr(1, LCase(.List(i, 2)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 3)), LCase(Str)) = 0 Then
    
                    .RemoveItem i
    
                End If
            Next i
    
        End With
    End If
    
    End Sub