Search Function: Table vs Array with results showing in Listbox

TSSPat

New Member
Joined
Jan 13, 2023
Messages
4
Office Version
  1. 365
  2. 2021
I have a declared Table (Table4) located in sheet (ALL).
Table4 is 9 columns wide by ~15,000 rows (rows will fluctuate).

I've successfully set up a Find Function that allows users to enter text into a TextBox (TB1) to dynamically search the values (xlValues) in Table4's Column "G" (header text= "Color").
Results are added as UserForm Listbox (LB1) items - but the function takes >30sec to complete.

In researching I've read that putting the Table into an Array - performing the search of said array, and then inputting any matching results (one or multiple) into a ListBox would significantly reduce this time.
I can make the array no problem, I can transpose said array to a listbox no problem. I just dont know how to perform the Search/Find function of the array items.

Stubbornness has had me banging my head on my desk for the last 5hrs trying everything to get this work but I should have come ask the exports hours ago.

Here's the original code that had the working TextBox/Table/Listbox interface.
Any pointers on how to transpose this into an Array search?

VBA Code:
Private Sub TB1_Change()
    
    Dim SearchTerm As String
    Dim SearchColumn As String
    Dim RecordRange As Range
    Dim FirstAddress As String
    Dim FirstCell As Range
    Dim RowCount As Integer
    
    'User enters Search value in TB1
    If TB1.Value <> "" Then
        SearchTerm = TB1.Value
        SearchColumn = "Color"
    End If
   
     'Searches in column G "Color"
        With Sheets("ALL").Range("Table4[" & SearchColumn & "]")
                
            'Find the 1st matching result
            Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)

            'If a match has been found
            If Not RecordRange Is Nothing Then

                FirstAddress = RecordRange.Address
                RowCount = 0

                Do
                
                    ' Set the first cell in the row of the matching value
                    Set FirstCell = Sheets("ALL").Range("A" & RecordRange.Row)
                    
                    ' Add matching record to List Box
                    LB1.AddItem
                    LB1.List(RowCount, 0) = FirstCell(1, 1)
                    LB1.List(RowCount, 1) = FirstCell(1, 2)
                    LB1.List(RowCount, 2) = FirstCell(1, 3)
                    LB1.List(RowCount, 3) = FirstCell(1, 4)
                    RowCount = RowCount + 1
                    
                    ' Look for next match
                    Set RecordRange = .FindNext(RecordRange)

                    ' When no further matches are found, exit the sub
                    If RecordRange Is Nothing Then

                        Exit Sub

                    End If

                ' Keep looking while unique matches are found
                Loop While RecordRange.Address <> FirstAddress

            Else

              ' If you get here, no matches were found
                LB1.AddItem
                LB1.List(RowCount, 2) = "No Matches Found!"
            
            End If
        End With
End Sub
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
I guess it may worth be asking before progressing. Would utilizing an Array truly reduce the search time as I've read elsewhere?

Also, for good measure I just added:
VBA Code:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'..... above code

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
and it managed to shave off 2 seconds to the search! 🎉🥳
 
Upvote 0
How about
VBA Code:
Private Sub TB1_Change()
   Dim Rws As Variant, Ary As Variant
   
   With Sheets("All").ListObjects("Table4")
      Rws = Filter(.Parent.Evaluate(Replace("transpose(if(isnumber(search(" & Chr(34) & Me.TB1.Value & Chr(34) & ",@)),row(@)-min(row(@))+1,false))", "@", .ListColumns("Color").DataBodyRange.Address)), False, False)
      If UBound(Rws) < 0 Then
         MsgBox "no match"
         Exit Sub
      ElseIf UBound(Rws) = 0 Then
         Ary = .DataBodyRange.Cells(Rws(0), 1).Resize(, 4)
      Else
         Ary = Application.Index(.DataBodyRange, Application.Transpose(Rws), [{1,2,3,4}])
      End If
      Me.LB1.List = Ary
   End With
End Sub
 
Upvote 0
Solution
How about
VBA Code:
Private Sub TB1_Change()
   Dim Rws As Variant, Ary As Variant
  
   With Sheets("All").ListObjects("Table4")
      Rws = Filter(.Parent.Evaluate(Replace("transpose(if(isnumber(search(" & Chr(34) & Me.TB1.Value & Chr(34) & ",@)),row(@)-min(row(@))+1,false))", "@", .ListColumns("Color").DataBodyRange.Address)), False, False)
      If UBound(Rws) < 0 Then
         MsgBox "no match"
         Exit Sub
      ElseIf UBound(Rws) = 0 Then
         Ary = .DataBodyRange.Cells(Rws(0), 1).Resize(, 4)
      Else
         Ary = Application.Index(.DataBodyRange, Application.Transpose(Rws), [{1,2,3,4}])
      End If
      Me.LB1.List = Ary
   End With
End Sub
It works - Almost INSTANT search (filter?) results! Time to expand my knowledgebase and dig into this Evaluate function.
Thanks Fluff, I've heard the legends but now I know first hand of your excel-lency.

Cheers 🥳
 
Upvote 0
Glad to help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top