Excel VBA to filter a table based on multiple search criteria entry in ActiveX Control Textbox

alex_n 

Try this:
It's similar to what HansVogelaar Hans proposed. It uses a temporary helper column, but the column is not part of the table. I put it 2 column next to the table.

How it works:
It uses a temporary helper column, but the column is not part of the table. I put it 2 column next to the table.
It's a live search i.e. the list will be filtered as you type
Type some keywords (it can be more than 2) in the textbox, separated by a space, e.g "ma la", the search ignores the keywords order, so keywords "ma la" will match "Maryland" and "Alabama"
The result will be displayed after you type the second character. The reason behind this is to speed up the search. Searching with 1 character will return the most results, and on large data sets it can give you a noticeable lag. Searching by 2 characters or more will be faster.
You can set this behavior in this part of the code:
Private Const CN As Long = 2 'start searching after typing certain number of character, change to suit

Speed test:
I tested it on 148K rows of data, and it gave me the result almost instantly.

The code:

'https://techcommunity.microsoft.com/t5/excel/excel-vba-to-filter-a-table-based-on-multiple-search-criteria/m-p/3812945
Option Explicit

Private va, vb
Private cell_Start As Range
Private oldVal As String

Private Const CN As Long = 2  'start searching after typing certain number of character

Private Sub CommandButton1_Click()
If Not cell_Start Is Nothing Then
    cell_Start.EntireColumn.Clear
End If
TextBox1.Text = ""
End Sub

Private Sub TextBox1_GotFocus()
    
    'load column 2 data to va
    With Sheets("Sheet1").ListObjects("Materials")
        va = .DataBodyRange.Columns(2).Value
        
        Set cell_Start = .Range.Cells(1).Offset(, .Range.Columns.Count + 1)
        cell_Start.Value = "Tag"
    End With
    
    Call add_1
         
End Sub

Private Sub add_1()

Dim i As Long
Dim t
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(vb, 1)
    vb(i, 1) = 1
Next
End Sub

Private Sub TextBox1_Change()
Dim tx1 As String

On Error GoTo skip:

        
    Application.EnableEvents = False
    Application.ScreenUpdating = False
        
    With TextBox1
 
            tx1 = UCase(Trim(.Value))
'
            If Len(tx1) < CN Then
                oldVal = tx1
                Call add_1
                cell_Start.Resize(UBound(vb, 1) + 1, 1).AutoFilter
                cell_Start.Offset(1).Resize(UBound(vb, 1), 1) = ""
            
            Else
            
                   If tx1 <> oldVal Then
    
                       If InStr(1, tx1, oldVal, vbBinaryCompare) = 0 Then Call add_1
                       
                       Call get_filterX
                        
                       cell_Start.Resize(UBound(vb, 1) + 1, 1).AutoFilter
                       cell_Start.Offset(1).Resize(UBound(vb, 1), 1) = vb
                       cell_Start.Resize(UBound(vb, 1) + 1, 1).AutoFilter Field:=1, Criteria1:="1"
                    
                   End If

            End If
        
        oldVal = tx1
    End With

        Application.EnableEvents = True
        Application.ScreenUpdating = True
        
Exit Sub
skip:
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Error number " & Err.Number & " : " & Err.Description

End Sub


Sub get_filterX()
'search without keyword order, case insensitive
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
    
    z = Split(Trim(UCase(TextBox1.Value)), " ")

    For i = 1 To UBound(va, 1)
            If vb(i, 1) = 1 Then
                v = UCase(va(i, 1))
                For Each q In z
                    If InStr(1, v, q, vbBinaryCompare) = 0 Then vb(i, 1) = 0: Exit For
                Next
            End If
    Next

End Sub