how to loop search to show multiple entries in listbox

[mj4287]

I need help with my code, im trying to create a searchable database using a userform. I would like to have a text box were a part number can be entered and then clicking a search button would perform a search in the tab “database” this tab holds all inventory details such as part number, description,qty,location ect. I have the below code that is working to return the correct information to the listbox based on the text box value, but the problem im having is setting it up to loop and return all entries in sheet “database” that match the value of the text box. Can you guys please help to get a loop in here and return all appropriate matches? Screen shoot below as well for reference. Also i would like once the records are returned to the listbox the user has the option to double click a line within the list box and have the corresponding information displayed in the textboxs above.

21463


Private Sub parts2_Click()
Dim rngToSearch As Range
Dim rngToFind As Range
Dim valToFind As Variant
Dim arrClearList()

valToFind = partsearch2.Value 'ComboBox name
With Worksheets("database")
Set rngToSearch = .Columns("A")
End With

Set rngToFind = rngToSearch.Find(What:=valToFind, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngToFind Is Nothing Then
ListBox2.AddItem
With ListBox2
.List(.ListCount - 1, 0) = rngToFind.Value 'part number
.List(.ListCount - 1, 1) = rngToFind.Offset(0, 1).Value 'desc
.List(.ListCount - 1, 2) = rngToFind.Offset(0, 2).Value 'stor loc
.List(.ListCount - 1, 3) = rngToFind.Offset(0, 3).Value 'bin loc
.List(.ListCount - 1, 4) = rngToFind.Offset(0, 4).Value 'qty
.List(.ListCount - 1, 5) = rngToFind.Offset(0, 5).Value 'mfg
.List(.ListCount - 1, 6) = rngToFind.Offset(0, 7).Value 'pm name
End With

Else
MsgBox valToFind & " Not found in Database."
End If
End Sub

[SamT]

Snippet

With Sheets("DataBase").Range("A:A")
Set Found = .Find( What, where, how)
If Found is Nothing then GoTo NotFound
FirstFoundAddress = Found.Address

Do
Add all info to list

Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found.Address <> FirstFoundAddress

End With
Exit Sub

NotFound:
MSgBox" Ooooooopsies!"
End Sub

[mj4287]

ive tried to plug in the above suggestion and have searched a ton of threads, however, i keep getting errors. is anyone able to incorporate a loop into the code i have above? im sure i just have a line or two out of order.... id really appreciate the help!

[yujin]

What kind of error do you get? Can you show us the code you embedded Do-Loop statement and FindNext method?

[mj4287]

here is the full code, i keep getting a handful of compile errors like end if without block if, loop without do ect. ive managed to get those errors out however now the code is not returning any data to the list box and ever search returns the msgbox "not found in database", im fairly new to the coding language and i think im just making it worse by trying to research and fix on my own, i feel like there is a couple small details that are being missed. any help is much appreciated!


Private Sub parts2_Click()
Dim i As Long, lastrow As Long




lastrow = Sheets("database").Range("a" & Rows.Count).End(xlUp).row
For i = 1 To lastrow
If Sheets("database").Cells(i, "A").Value = (Me.Partnumber2.Value) Or _
Sheets("database").Cells(i, "A").Value = (Me.Partnumber2.Value) Then
Me.partsearch2 = Sheets("database").Cells(i, "a").Value
Me.ComboBox5 = Sheets("database").Cells(i, "f").Value
Me.StorLoc2 = Sheets("database").Cells(i, "c").Value
Me.BinLoc2 = Sheets("database").Cells(i, "d").Value
Me.QTY2 = Sheets("database").Cells(i, "e").Value
Me.ComboBox6 = Sheets("database").Cells(i, "h").Value
Me.Desc2 = Sheets("database").Cells(i, "B").Value
Me.rownumber2 = Sheets("database").Cells(i, "K").Value
End If
Next

Dim rngToSearch As Range
Dim rngToFind As Range
Dim valToFind As Variant
Dim arrClearList()
Dim row As Integer
ListBox2.Clear

valToFind = Me.partsearch2.Value 'ComboBox name

With Worksheets("database")
Set rngToSearch = .Columns("A")
End With


Set rngToFind = rngToSearch.Find(What:=valToFind, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rngToFind Is Nothing And partsearch2.Value = "" Then
GoTo found
Else
MsgBox ("Not found in Database")
End If
Exit Sub
found:


Do
DoEvents
If Sheets("database").Cells(i, "A").Value = (Me.Partnumber2.Value) Then

ListBox2.AddItem
With ListBox2
.List(.ListCount - 1, 0) = rngToFind.Value 'part number
.List(.ListCount - 1, 1) = rngToFind.Offset(0, 1).Value 'desc
.List(.ListCount - 1, 2) = rngToFind.Offset(0, 2).Value 'stor loc
.List(.ListCount - 1, 3) = rngToFind.Offset(0, 3).Value 'bin loc
.List(.ListCount - 1, 4) = rngToFind.Offset(0, 4).Value 'qty
.List(.ListCount - 1, 5) = rngToFind.Offset(0, 5).Value 'mfg
.List(.ListCount - 1, 6) = rngToFind.Offset(0, 7).Value 'pm name


End With
End If

Loop


End Sub

[mj4287]

this is the other variation of code, this error keeps saying "object required" on line (strSearch = Partnumber2.Text)






Private Sub parts2_Click()
Set xSht = Sheets("Database")
lastrow = xSht.Range("A" & Rows.Count).End(xlUp).row
strSearch = Partnumber2.Text
Set aCell = xSht.Range("A1:A" & lastrow).Find(What:=strSearch, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
GoTo PartSearch2valid
Else
MsgBox "Part number not in Database."
End If
Exit Sub
PartSearch2valid:
Dim i As Integer
'lstResults.ColumnCount = 4
'lstResults.ColumnWidths = "60;60;60;0"
ListBox2.Clear
For i = 1 To lastrow
item_in_review = Sheets("database").Range("A" & i)
If item_in_review = Partnumber2.Text Then

ListBox2.AddItem
With ListBox2
.List(.ListCount - 1, 0) = rngToFind.Value 'part number
.List(.ListCount - 1, 1) = rngToFind.Offset(0, 1).Value 'desc
.List(.ListCount - 1, 2) = rngToFind.Offset(0, 2).Value 'stor loc
.List(.ListCount - 1, 3) = rngToFind.Offset(0, 3).Value 'bin loc
.List(.ListCount - 1, 4) = rngToFind.Offset(0, 4).Value 'qty
.List(.ListCount - 1, 5) = rngToFind.Offset(0, 5).Value 'mfg
.List(.ListCount - 1, 6) = rngToFind.Offset(0, 7).Value 'pm name
End With
End If
Next i
End Sub

[yujin]

Hmm... you are not correctly using Find and FindNext method to find all matches in the database sheet.
Embedding SamT's code in your original code, you'll get the code like below. Try it.


Private Sub part2_Click()
Dim rngToSearch As Range
Dim rngToFind As Range
Dim valToFind As Variant
Dim FirstFoundAddress As String

ListBox2.Clear

valToFind = partsearch2.Value 'ComboBox name
With Worksheets("database")
Set rngToSearch = .Columns("A")
End With

Set rngToFind = rngToSearch.Find(What:=valToFind, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngToFind Is Nothing Then
FirstFoundAddress = rngToFind.Address

Do
DoEvents
ListBox2.AddItem
With ListBox2
.List(.ListCount - 1, 0) = rngToFind.Value 'part number
.List(.ListCount - 1, 1) = rngToFind.Offset(0, 1).Value 'desc
.List(.ListCount - 1, 2) = rngToFind.Offset(0, 2).Value 'stor loc
.List(.ListCount - 1, 3) = rngToFind.Offset(0, 3).Value 'bin loc
.List(.ListCount - 1, 4) = rngToFind.Offset(0, 4).Value 'qty
.List(.ListCount - 1, 5) = rngToFind.Offset(0, 5).Value 'mfg
.List(.ListCount - 1, 6) = rngToFind.Offset(0, 6).Value 'pm name
End With
Set rngToFind = rngToSearch.FindNext(rngToFind)
Loop While Not rngToFind Is Nothing And rngToFind.Address <> FirstFoundAddress
Else
MsgBox valToFind & " Not found in Database."
End If
End Sub

[yujin]

And here's the code for the option you want.


Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With Me
.Desc.Value = ListBox2.List(ListBox2.ListIndex, 1)
.Stor_Loc.Value = ListBox2.List(ListBox2.ListIndex, 2)
.Bin_Loc.Value = ListBox2.List(ListBox2.ListIndex, 3)
.QTY.Value = ListBox2.List(ListBox2.ListIndex, 4)
.MFG.Value = ListBox2.List(ListBox2.ListIndex, 5)
.PM.Value = ListBox2.List(ListBox2.ListIndex, 6)
End With
End Sub

[mj4287]

Thank you!!! works perfectly your the man!!! :clap: