Typing is very slow in search box

Paulo H

Board Regular
Joined
Jun 10, 2020
Messages
106
Office Version
  1. 2016
Platform
  1. Windows
Hi

I have created a sheet that searches a price list from the description colulmn and also company column of the price list then puts into the list box

I works fine but typing in the search box Textbox1 is very slow/laggy

I can't seem to speed it up

the code is
VBA Code:
Private Sub TextBox1_Change()
Dim I As Long
Me.TextBox1 = Format(StrConv(Me.TextBox1, vbLowerCase))
Me.ListBox1.Clear
Me.ListBox1.AddItem "Item"
Me.ListBox1.List(0, 2) = "Company"
Me.ListBox1.List(0, 1) = "Description"
Me.ListBox1.List(0, 3) = "Cost"
Me.ListBox1.Selected(0) = True
For I = 2 To Sheets("Prices").Range("D1000").End(xlUp).Row
For X = 1 To Len(Sheets("Prices").Cells(I, 2))
A = Me.TextBox1.TextLength
If LCase(Mid(Sheets("Prices").Cells(I, 2), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem Sheets("Prices").Cells(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & Sheets("Prices").Cells(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(Sheets("Prices").Cells(I, 14), "£#,00.00")

Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & Sheets("Prices").Cells(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & Sheets("Prices").Cells(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & Sheets("Prices").Cells(I, 16)
ElseIf LCase(Mid(Sheets("Prices").Cells(I, 4), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem Sheets("Prices").Cells(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & Sheets("Prices").Cells(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(Sheets("Prices").Cells(I, 14), "£#,00.00")
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & Sheets("Prices").Cells(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & Sheets("Prices").Cells(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & Sheets("Prices").Cells(I, 16)
End If
Next X
Next I

End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,658
Office Version
  1. 2010
Platform
  1. Windows
you can speed it up by a factor of 1000 or so by loading all the data into a variant array instead of doing a double loop through the worksheet, like this ( untested)
VBA Code:
lastrow = Sheets("Prices").Range("D1000").End(xlUp).Row
inarr = Sheets("Prices").Range(Cells(1, 1), Cells(lastrow, 16))

For I = 2 To lastrow
For X = 1 To Len(inarr(I, 2))
A = Me.TextBox1.TextLength
If LCase(Mid(inarr(I, 2), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem inarr(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & inarr(I, 2)
'Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(inarr(I, 14), "£#,00.00") ' move outside the loop

Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & inarr(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 16)
ElseIf LCase(Mid(inarr(I, 4), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem inarr(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & inarr(I, 2)
'Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(inarr(I, 14), "£#,00.00") ' move outside the inner loop
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & inarr(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 16)
End If
Next X
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(Sheets("Prices").Cells(I, 14), "£#,00.00")

Next I
 
Last edited:

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,723
Hi Paulo H. This is a textbox change event so every time U type a letter all that code has to run and re-run with every letter typed. I'm guessing U only want it executed once when the user has completed their textbox business. So U could use a different textbox event like exit or determine an alternate way of running the code after the user is finished with the textbox (maybe command button or option button?). HTH. Dave
 

Paulo H

Board Regular
Joined
Jun 10, 2020
Messages
106
Office Version
  1. 2016
Platform
  1. Windows
Many thanks for your help

I have tried this but get a runtime message 1004
1607104708816.png


1607104672188.png

Sorry if I am missing something obvious

Thanks again
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,658
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Sorry about that I did say it was untested , try this:
VBA Code:
With Worksheets("Prices")
lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 16))
End With

For I = 2 To lastrow
For X = 1 To Len(inarr(I, 2))
A = Me.TextBox1.TextLength
If LCase(Mid(inarr(I, 2), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem inarr(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & inarr(I, 2)
'Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(inarr(I, 14), "£#,00.00") ' move outside the loop

Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & inarr(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 16)
ElseIf LCase(Mid(inarr(I, 4), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem inarr(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & inarr(I, 2)
'Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(inarr(I, 14), "£#,00.00") ' move outside the inner loop
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & inarr(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 16)
End If
Next X
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(Sheets("Prices").Cells(I, 14), "£#,00.00")

Next I
 
Solution

Paulo H

Board Regular
Joined
Jun 10, 2020
Messages
106
Office Version
  1. 2016
Platform
  1. Windows
Sorry about that I did say it was untested , try this:
VBA Code:
With Worksheets("Prices")
lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 16))
End With

For I = 2 To lastrow
For X = 1 To Len(inarr(I, 2))
A = Me.TextBox1.TextLength
If LCase(Mid(inarr(I, 2), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem inarr(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & inarr(I, 2)
'Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(inarr(I, 14), "£#,00.00") ' move outside the loop

Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & inarr(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 16)
ElseIf LCase(Mid(inarr(I, 4), X, A)) = Me.TextBox1 And Me.TextBox1 <> "" Then
Me.ListBox1.AddItem inarr(I, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "" & inarr(I, 2)
'Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(inarr(I, 14), "£#,00.00") ' move outside the inner loop
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 2)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "" & inarr(I, 4)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "" & inarr(I, 16)
End If
Next X
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Format(Sheets("Prices").Cells(I, 14), "£#,00.00")

Next I
Hi

Thanks again for your help

It seems to have speeded up the input into the text box but nothing id appearing in the listbox below unfortunately

Thanks again
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,658
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

My code doesn't change anything to do with the list box, was it working before the change??
 

Paulo H

Board Regular
Joined
Jun 10, 2020
Messages
106
Office Version
  1. 2016
Platform
  1. Windows
Yes it is working with the original code

I noticed that the range in new code just says “D” is that ok
Thanks again
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,658
Office Version
  1. 2010
Platform
  1. Windows
The Range "D" is the same as you had, I suggest you step through the code using the debug and see what is happening, The changes I have made shouldn't make any difference just change the worksheet range to the variant array, so check that the values in Inarr(I,2) is what you are expecting
 

Paulo H

Board Regular
Joined
Jun 10, 2020
Messages
106
Office Version
  1. 2016
Platform
  1. Windows
The Range "D" is the same as you had, I suggest you step through the code using the debug and see what is happening, The changes I have made shouldn't make any difference just change the worksheet range to the variant array, so check that the values in Inarr(I,2) is what you are expecting
Thank you I will give it a try

Cheers
 

Watch MrExcel Video

Forum statistics

Threads
1,122,988
Messages
5,599,217
Members
414,297
Latest member
dalkarl

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
Top