Live Search Box for Cells Containing

[TBrecht]

Hello All,
I have added a search box that is linked to a cell and have it searching/filtering my table as I type. Now my issue is everything that I type in to search needs to be in the same order as my Description column in the Table. The problem with this is i have thousands of different items and not all of the verbiage follows a standard. Below is the code that I currently have. I added some buttons from youtube in hopes to fix this with no luck . Realistically my plan would be to remove the begins with and only search for contains if possible.

One Example being. My cell contains "Tel-Tru GT300R Thermometer Temp. Gauge - 0-250F , 3" Dial, 9" Stem Length, 1/2" MNPT Polycarbonate Lens". I would like to search "Thermometer 9" Stem Length 0-250F"

Any help/recommendation is appreciated! Thank you!

Private Sub BeginsWith_Click()
Call SearchBox_Change
End Sub

Private Sub Contains_Click()
Call SearchBox_Change
End Sub

Private Sub SearchBox_Change()
If optbeginsWith Then
    ListObjects("PartsDatabase").Range.AutoFilter field:=6, Criteria1:=Range("F2") & "*"
Else
    ListObjects("PartsDatabase").Range.AutoFilter field:=6, Criteria1:="*" & Range("F2") & "*"
End If

End Sub

 

[Akuini]

Hi, @TBrecht
Here's an example of a search textbox in sheet.
The search ignores the keywords order, so keywords "ma la" will find "Maryland" and "Alabama"

dhee - search textbox ignore order

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[Akuini]

The code:

Option Explicit

Private Sub TextBox1_GotFocus()
Dim n As Long
    'get last row of table
    n = Range("B" & Rows.Count).End(xlUp).Row
    'create named range refer to helper range
    ThisWorkbook.Names.Add Name:="zName", RefersTo:=Range("E5:E" & n)

End Sub
Private Sub TextBox1_Change()

Dim i As Long
Dim z, q, va, vb
Dim flag As Boolean


va = ActiveSheet.ListObjects("Table1").Range.Columns(1).Value

ReDim vb(1 To UBound(va, 1), 1 To 1)
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    
If TextBox1.Value = Empty Then
    Exit Sub

Else
    z = Split(TextBox1.Value, " ")

    For i = 2 To UBound(va, 1)
        
        flag = True
        
        For Each q In z
            If InStr(1, va(i, 1), q, vbTextCompare) = 0 Then flag = False: Exit For
        Next
            
        If flag = True Then vb(i, 1) = 1
    
    Next

End If

Application.ScreenUpdating = False
    With Range("zName")
        .Value = vb
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).ClearContents
    End With
Application.ScreenUpdating = True

End Sub

 

[TBrecht]

Thanks! Played with it a little bit and looks like it will work! Much appreciated!

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.

 

[TBrecht]

I may have spoken to soon. I put the code into my sheet and after I type in 2 letters I get an error Debug highlights "ActiveSheet.ShowAllData" I feel like I am missing something super simple on this one. The filter box shows up away from my table and I need to manually clear it to reset it and column F is where I need to search through.

Option Explicit

Private Sub SearchBox1_GotFocus()
Dim n As Long
    'get last row of table
    n = Range("F" & Rows.Count).End(xlUp).Row
    'create named range refer to helper range
    ThisWorkbook.Names.Add Name:="zName", RefersTo:=Range("O4:O" & n)

End Sub
Private Sub SearchBox1_Change()

Dim i As Long
Dim z, q, va, vb
Dim flag As Boolean


va = ActiveSheet.ListObjects("Table6").Range.Columns(5).Value

ReDim vb(1 To UBound(va, 1), 1 To 1)
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    
If Searchbox1.Value = Empty Then
    Exit Sub

Else
    z = Split(Searchbox1.Value, " ")

    For i = 2 To UBound(va, 1)
        
        flag = True
        
        For Each q In z
            If InStr(1, va(i, 1), q, vbTextCompare) = 0 Then flag = False: Exit For
        Next
            
        If flag = True Then vb(i, 1) = 1
    
    Next

End If

Application.ScreenUpdating = False
    With Range("zName")
        .Value = vb
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).ClearContents
    End With
Application.ScreenUpdating = True

End Sub

 

[Akuini]

after I type in 2 letters I get an error Debug highlights "ActiveSheet.ShowAllData"

In the code, try adding the blue line (change "Table1" to suit):

ReDim vb(1 To UBound(va, 1), 1 To 1)

ActiveSheet.ListObjects("Table1").ShowAutoFilter = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

The filter box shows up away from my table and I need to manually clear it to reset it and column F is where I need to search through.

Not sure why that happened. Where do you put the search box? It should be above the table, not parallel to it.

If the problem is not resolved then could you upload a sample workbook to a free site such as dropbox.com or google drive & then share the link here?