Multi column listbox and textbox search

[Anthony86]

Hi Guys,

I've got a user form with a listbox and textbox.
What I'm trying to achieve is when I type things in the textbox it searches the listbox and removes anything that doesnt relate.("*" Wildcard "*") The column I want it to search in is column C and it currently has 6 columns. What is the fastest way to achieve this without taking to much of a hit on processing?

 

[Waimea]

Hi,

how are you populating the listbox?

Are you using column headers?

 

[Anthony86]

Hi, I'm not using column headers as I've designed labels as the headers.

Private Sub UserForm_Initialize()ListBox1.ColumnCount = 6
ListBox1.ColumnWidths = "80,80,245,80,78"
ListBox1.RowSource = "DataList"


End Sub

 

[Anthony86]

I was using this snippet of code to search on a smaller database, but now I have a really big database the code isn't working.

Dim X, i As Long, ii As Long, iii As Integer    X = [DataList]
    
    With ListBox1
        If TextBox1 = "" Then
            .RowSource = "DataList"
        Else
            .RowSource = ""
            For i = 1 To UBound(X, 1)
                If LCase(X(i, 3)) Like LCase(TextBox1) & "*" Then
                    For ii = 1 To 6
                        .AddItem
                        .List(iii, ii - 1) = X(i, ii)
                    Next
                    iii = iii + 1
                End If
            Next
        End If
    End With

 

[DanteAmor]

Try this
For a base of 20,000 records it takes less than a second for every letter you enter in the textbox.

Private Sub TextBox1_Change()
  Dim a, sh As Worksheet, i As Long, j As Long
  ListBox1.Clear
  Set sh = Sheets("Sheet1")
  a = sh.Range("A2:F" & sh.Range("C" & Rows.Count).End(xlUp).Row)
  j = 1
  ReDim b(1 To UBound(a), 1 To 6)
  For i = 1 To UBound(a)
    If a(i, 3) Like "*" & TextBox1.Value & "*" Then
      b(j, 1) = a(i, 1)
      b(j, 2) = a(i, 2)
      b(j, 3) = a(i, 3)
      b(j, 4) = a(i, 4)
      b(j, 5) = a(i, 5)
      b(j, 6) = a(i, 6)
      j = j + 1
    End If
  Next
  ListBox1.List = b()
End Sub

 

[Anthony86]

Try this
For a base of 20,000 records it takes less than a second for every letter you enter in the textbox.

Private Sub TextBox1_Change()
  Dim a, sh As Worksheet, i As Long, j As Long
  ListBox1.Clear
  Set sh = Sheets("Sheet1")
  a = sh.Range("A2:F" & sh.Range("C" & Rows.Count).End(xlUp).Row)
  j = 1
  ReDim b(1 To UBound(a), 1 To 6)
  For i = 1 To UBound(a)
    If a(i, 3) Like "*" & TextBox1.Value & "*" Then
      b(j, 1) = a(i, 1)
      b(j, 2) = a(i, 2)
      b(j, 3) = a(i, 3)
      b(j, 4) = a(i, 4)
      b(j, 5) = a(i, 5)
      b(j, 6) = a(i, 6)
      j = j + 1
    End If
  Next
  ListBox1.List = b()
End Sub

This works great, and is really fast. Thank you

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.