Consulting

Results 1 to 9 of 9

Thread: how to loop search to show multiple entries in listbox

  1. #1
    VBAX Newbie
    Joined
    Jan 2018
    Posts
    5
    Location

    how to loop search to show multiple entries in listbox

    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.

    LISTBOX.jpg

    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
    Last edited by SamT; 01-26-2018 at 01:16 PM. Reason: Added Code Formatting Tags via # Icon

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    VBAX Newbie
    Joined
    Jan 2018
    Posts
    5
    Location
    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!

  4. #4
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    What kind of error do you get? Can you show us the code you embedded Do-Loop statement and FindNext method?

  5. #5
    VBAX Newbie
    Joined
    Jan 2018
    Posts
    5
    Location
    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

  6. #6
    VBAX Newbie
    Joined
    Jan 2018
    Posts
    5
    Location
    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

  7. #7
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    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

  8. #8
    VBAX Regular
    Joined
    Jan 2018
    Posts
    55
    Location
    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

  9. #9
    VBAX Newbie
    Joined
    Jan 2018
    Posts
    5
    Location
    Thank you!!! works perfectly your the man!!!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •