Speed up search code currently in use

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Hi,
I am using the code below.
On my userform in a TextBox i type a value to be found on my worksheet.
All found values then populate my ListBox

Sometimes a common value like FORD FIESTA is used.
My issue is that the search / population can take some time & on occasion the userform vanishes from sight whilst the code is doing its job.
Once done the userform is shown & ListBox is populated.

Can the code be edited so this doesnt happen or do you see an issue in the code that makes it happen.
Thanks

Rich (BB code):
Private Sub TextBoxSearchColumnC_Change()
  Dim R As Range, f As Range, cell As String, added As Boolean
  Dim sh As Worksheet
  
  Set sh = Sheets("POSTAGE")
  sh.Select
  With ListBoxFind
    .Clear
    .ColumnCount = 2
    .ColumnWidths = "100;0"
    If TextBoxSearchColumnC.Value = "" Then Exit Sub
    Set R = Range("C9", Range("C" & Rows.Count).End(xlUp))
    Set f = R.Find(TextBoxSearchColumnC.Value, LookIn:=xlValues, LookAt:=xlPart)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        added = False
        For i = 0 To .ListCount - 1
          Select Case StrComp(.List(i), f.Value, vbTextCompare)
            Case 0, 1
              .AddItem f.Value, i
              .List(i, 1) = f.Row
              added = True
              Exit For
          End Select
        Next
           If added = False Then
          .AddItem f.Value
          .List(.ListCount - 1, 1) = f.Row
        End If
        Set f = R.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
      TextBoxSearchColumnC = UCase(TextBoxSearchColumnC)
      .TopIndex = 0
      Else
      MsgBox "NO ITEM WAS FOUND USING THAT INFORMATION", vbCritical, "POSTAGE SHEET ITEM SEARCH"
      TextBoxSearchColumnC.Value = ""
      TextBoxSearchColumnC.SetFocus
    End If
  End With
  Me.ListBoxReplace.List = Me.ListBoxFind.List
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hi @ipbr21054. I hope you are well

The following code performs the sort with the System.Collections.ArrayList object.

I did a test with over a hundred thousand records and the result is in 1 second.

VBA Code:
Private Sub TextBoxSearchColumnC_Change()
  Dim sh As Worksheet
  Dim rng As Range
  Dim i As Long, k As Long, n As Long
  Dim a As Variant, b As Variant
  Dim coll As Object
 
  Set sh = Sheets("POSTAGE")
  Set rng = sh.Range("C9", Range("C" & Rows.Count).End(xlUp))
  Set coll = CreateObject("System.Collections.ArrayList")
 
  With ListBoxFind
    .Clear
    .ColumnCount = 2
    .ColumnWidths = "100;0"
  End With
 
  If TextBoxSearchColumnC.Value = "" Then Exit Sub
 
  n = WorksheetFunction.CountIf(rng, "*" & LCase(TextBoxSearchColumnC.Value) & "*")
  If n = 0 Then
    MsgBox "NO ITEM WAS FOUND USING THAT INFORMATION", vbCritical, "POSTAGE SHEET ITEM SEARCH"
    TextBoxSearchColumnC.Value = ""
    TextBoxSearchColumnC.SetFocus
    Exit Sub
  End If
 
  a = rng.Value
  ReDim b(1 To n, 1 To 2)
 
  For i = 1 To UBound(a, 1)
    If LCase(a(i, 1)) Like "*" & LCase(TextBoxSearchColumnC.Value) & "*" Then
      coll.Add a(i, 1) & "|" & i + 8
    End If
  Next
 
  coll.Sort
  For i = 0 To coll.Count - 1
    k = k + 1
    b(k, 1) = Split(coll(i), "|")(0)
    b(k, 2) = Split(coll(i), "|")(1)
  Next
 
  ListBoxFind.List = b
  ListBoxReplace.List = ListBoxFind.List
End Sub

Please do the test with your data and you tell me.
--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------
 
Upvote 0
Solution

Forum statistics

Threads
1,214,812
Messages
6,121,704
Members
449,048
Latest member
81jamesacct

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