Typing is very slow in search box

[Paulo H]

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

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

 

[offthelip]

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)

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

 

[NdNoviceHlp]

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]

Many thanks for your help

I have tried this but get a runtime message 1004

Sorry if I am missing something obvious

Thanks again

 

[offthelip]

Sorry about that I did say it was untested , try this:

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

 

[Paulo H]

Sorry about that I did say it was untested , try this:

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]

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

 

[Paulo H]

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]

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]

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