Create a working search box

[luckysmit]

I have tried a few ways to use a sech box in a user form, each time i find a road block. i am only getting back in to using vba and this has stretched my knowledge,

in the example i am tiring to allow the user to type in a search term and have it retune the top results, in this case i want to use
text box 7,
to look at sheet 3
and retune all the results to list box 1

Code is below image

Thanks for all the help so far. I have been going through your forum to get this far. its a great resource. Now i am stuck i really need individual hep. Thanks again for any time you can give.


Private Sub Clear()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButtion"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Sub

Private Sub CommandButton2_Click()
Call Clear
End Sub

Private Sub TextBox7_Change()
Dim ws As Worksheet
Dim i As Long, j As Long, k As Long
Dim cad As String
Set ws = Sheet3
With Me.ListBox1
.Clear
.ColumnCount = 7
.ColumnWidths = "80 pt;180 pt;80 pt;80 pt;80 pt;80 pt;80 pt"
.ColumnHeads = 0
For i = 1 To ws.Range("B" & Rows.Count).End(3).Row
cad = ""
For j = 1 To Columns("O").Column
Next
If LCase(cad) Like "*" & LCase(TextBox1.Text) & "*" Then
.AddItem
.List(k, 0) = ws.Cells(i, 1)
.List(k, 1) = ws.Cells(i, 3)
.List(k, 2) = ws.Cells(i, 4)
.List(k, 3) = ws.Cells(i, 16)
.List(k, 4) = ws.Cells(i, 17)
.List(k, 5) = ws.Cells(i, 18)
.List(k, 6) = ws.Cells(i, 10)
k = k + 1
End If
Next
If .ListCount = 0 Then
MsgBox "No match"
TextBox1.SetFocus
End If
End With
End Sub

Private Sub CommandButton1_Click()
Dim emptyRow As Long
Dim screwID As Long
'Make Sheet1 active
Sheet5.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = DateTime.Now
Cells(emptyRow, 2).Value = TextBox1.Value
Cells(emptyRow, 3).Value = TextBox5.Value
Cells(emptyRow, 4).Value = TextBox6.Value
Cells(emptyRow, 5).Value = TextBox4.Value
Cells(emptyRow, 6).Value = TextBox2.Value
Cells(emptyRow, 7).Value = TextBox3.Value
Dim Output As Integer
If MsgBox("Part(s) Booked Out by " & TextBox1.Value & vbCrLf & vbCrLf & "Book out another part?", _
vbYesNo, "Booking Status") = vbYes Then
TextBox2.Value = ""
TextBox3.Value = ""
Else
Sheet1.Activate
Call Clear
Call CloseForm
End If
End Sub

Private Sub CloseForm()
Unload Me
ActiveWorkbook.Save
End Sub

[Aussiebear]

Welcome to the VBAX forum, luckysmit. You will notice that I've changed a couple of things in your post.

Firstly, when presenting code to the forum, we would prefer that you wrap your code in Code Tags. See the Hash icon third from the right in the grey section immediately above your post? If you select your code then select that icon it wraps your code with the preferred code tags.

Secondly, sections of code the Start "Private Sub".... "End Sub" with no code in-between are basically irrelevant and really shouldn't be included. For that reason I have deleted them.

And finally, For long lines of code, try breaking then a reasonable length by selecting a point, add a space then the Underscore hypen and press enter to start a new line. Most people have small screens and this makes your code more readable to them.

Hope this helps you for future posts.

[georgiboy]

Perhaps the below will help, there were a few issues i spotted. I have reduced the amount of columns being returned as there was only 15 columns of data so refering to 16 & 17 etc. was causing an error. I also made it return the results from an array rather than looking at the worksheet ranges.

Try it as below:

Dim rVar As Variant

Private Sub UserForm_Initialize()
rVar = Sheet3.UsedRange
End Sub


Private Sub TextBox7_Change()
Dim i As Long, j As Long, k As Long
Dim cad As String


With Me.ListBox1
.Clear
.ColumnCount = 7
.ColumnWidths = "80 pt;180 pt;80 pt;80 pt;80 pt;80 pt;80 pt"
.ColumnHeads = 0


For i = 1 To UBound(rVar)
If InStr(LCase(rVar(i, 4)), LCase(TextBox7.Text)) Then
.AddItem
.List(k, 0) = rVar(i, 1)
.List(k, 1) = rVar(i, 3)
.List(k, 2) = rVar(i, 4)
' add more columns here
k = k + 1
End If
Next


If .ListCount = 0 Then
MsgBox "No match"
TextBox1.SetFocus
End If
End With
End Sub


Private Sub Clear()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButtion"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Sub


Private Sub CommandButton1_Click()
Dim emptyRow As Long
Dim screwID As Long

'Make Sheet1 active
Sheet5.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
Cells(emptyRow, 1).Value = DateTime.Now
Cells(emptyRow, 2).Value = TextBox1.Value
Cells(emptyRow, 3).Value = TextBox5.Value
Cells(emptyRow, 4).Value = TextBox6.Value
Cells(emptyRow, 5).Value = TextBox4.Value
Cells(emptyRow, 6).Value = TextBox2.Value
Cells(emptyRow, 7).Value = TextBox3.Value

Dim Output As Integer
If MsgBox("Part(s) Booked Out by " & TextBox1.Value & vbCrLf & vbCrLf & "Book out another part?", vbYesNo, "Booking Status") = vbYes Then
TextBox2.Value = ""
TextBox3.Value = ""
Else
Sheet1.Activate
Call Clear
Call CloseForm
End If
End Sub


Private Sub CloseForm()
Unload Me
ActiveWorkbook.Save
End Sub

[arnelgp]

your search is somewhat very slow.
you test this one.

[luckysmit]

Thanks a lot for all the help, i appreciate all the support and knowledge. It works a treat,

[Aussiebear]

Okay, if you have a solution to your query, can you please go to the Thread Tools Option and select "Mark this thread as solved"?