'Search' List Box Double Click function

[john_liquid]

I have set up a search function on a userform which searches for business names in all sheets of the attached worksheet.

Ideally, when the options show up in the list box, when I double click one of them, I would like the Userform to automatically fill out with the data of the particular business chosen. If someone then wanted to change the information, I plan to add an 'Amend' button to the Userform. What would be the best of going about achieving this?

Also, when the search results show up in the listbox, is there any way of showing up the 'Status' information alongside the business name?

Here's the code:

Option Explicit

Private Sub RegionDrpDwn_AfterUpdate()
With Me.CityCountyDrpDwn
    Select Case RegionDrpDwn.ListIndex
        Case 0: .List = Sheets("Info").Range("C4:C40").Value
        Case 1: .List = Sheets("Info").Range("D4:D21").Value
        Case 2: .List = Sheets("Info").Range("E4:E17").Value
        Case 3: .List = Sheets("Info").Range("F4:F12").Value
        Case 4: .List = Sheets("Info").Range("G4:G12").Value
    End Select
    End With
End Sub
Private Sub cmdselectblog_AfterUpdate()
    
    With Me.featuredpostareacategory
        Select Case cmdselectblog.ListIndex
            Case 0: .RowSource = "Info!I4:I14"
            Case 1: .RowSource = "Info!L4:L8"
            Case 2: .RowSource = "Info!O4:O14"
            Case 3: .RowSource = "Info!R4:R5"
            Case 4: .RowSource = "Info!U4:U5"
        End Select
    End With
    With Me.featuredpostcategory1
        Select Case cmdselectblog.ListIndex
            Case 0: .RowSource = "Info!J4:J5"
            Case 1: .RowSource = "Info!M4:M9"
            Case 2: .RowSource = "Info!P4:P5"
            Case 3: .RowSource = "Info!S4:S5"
            Case 4: .RowSource = "Info!V4:V5"
        End Select
    End With
    With Me.featuredpostcategory2
        Select Case cmdselectblog.ListIndex
            Case 0: .RowSource = "Info!K4:K5"
            Case 1: .RowSource = "Info!N4:N9"
            Case 2: .RowSource = "Info!Q4:Q5"
            Case 3: .RowSource = "Info!T4:T5"
            Case 4: .RowSource = "Info!W4:W5"
        End Select
    End With
End Sub

Private Sub Addbutton_Click()
' set form to workbook
    Dim sht As Worksheet
    Dim NextRw As Long

    Set sht = Sheets(Me.cmdselectblog.Value)
    With sht
        NextRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        

        ' enter data from form to worksheet

        .Cells(NextRw, 1).Value = Me.BusinessNameTxtBox.Value
        .Cells(NextRw, 2).Value = Me.StatusDrpDwn.Value
        .Cells(NextRw, 3).Value = Me.cmdselectblog.Value
        .Cells(NextRw, 4).Value = Me.ContactNameTxtBox.Value
        .Cells(NextRw, 5).Value = Me.JobTitleTxtBox.Value
        .Cells(NextRw, 6).Value = Me.RegionDrpDwn.Value
        .Cells(NextRw, 7).Value = Me.CityCountyDrpDwn.Value
        .Cells(NextRw, 8).Value = Me.ActualLocationTxtBox.Value
        .Cells(NextRw, 9).Value = Me.DirectNumberTxtBox.Value
        .Cells(NextRw, 10).Value = Me.OtherPhoneNumberTxtBox.Value
        .Cells(NextRw, 11).Value = Me.EMailAddressTxtBox.Value
        .Cells(NextRw, 12).Value = Me.WebsiteTxtBox.Value
        .Cells(NextRw, 13).Value = Me.Notes1TxtBox.Value
    End With

    'clear the data in form
    With Me
        .BusinessNameTxtBox.Value = ""
        .StatusDrpDwn.Value = ""
        .cmdselectblog.Value = ""
        .ContactNameTxtBox.Value = ""
        .JobTitleTxtBox.Value = ""
        .RegionDrpDwn.Value = ""
        .CityCountyDrpDwn.Value = ""
        .ActualLocationTxtBox.Value = ""
        .DirectNumberTxtBox.Value = ""
        .OtherPhoneNumberTxtBox.Value = ""
        .EMailAddressTxtBox.Value = ""
        .WebsiteTxtBox.Value = ""
        .Notes1TxtBox.Value = ""
        End With
End Sub



Sub Locate(Name As String, Data As Range)

    Dim rngFind As Range
    Dim strFirstFind As String
    
    With Data
        Set rngFind = .Find(Name, LookIn:=xlValues, lookat:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            Do
                If rngFind.Row > 1 Then
                    busnamesearchlistbox.AddItem rngFind.Value
                    busnamesearchlistbox.List(busnamesearchlistbox.ListCount - 1, 1) = Data.Parent.Name
                    busnamesearchlistbox.List(busnamesearchlistbox.ListCount - 1, 2) = Data.Parent.Name & "!" & rngFind.Address
                End If
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
    
End Sub

Private Sub cmdbusnamesearch_Click()

    Dim shtSearch As Worksheet
    
    busnamesearchlistbox.Clear
    For Each shtSearch In ThisWorkbook.Worksheets
        Locate txtsearchbox.Text, shtSearch.Range("a:a")
    Next
    If busnamesearchlistbox.ListCount = 0 Then
        busnamesearchlistbox.AddItem "No Match Found"
        busnamesearchlistbox.List(0, 1) = ""
        busnamesearchlistbox.List(0, 2) = ""
    End If
End Sub

Private Sub busnamesearchlistbox_Click()

End Sub


Private Sub busnamesearchlistbox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    Dim strSheet As String
    Dim strAddress As String
    
    strSheet = busnamesearchlistbox.List(busnamesearchlistbox.ListIndex, 1)
    strAddress = busnamesearchlistbox.List(busnamesearchlistbox.ListIndex, 2)
    If strAddress <> "" Then
        Worksheets(strSheet).Activate
        Range(strAddress).Activate
    End If
End Sub

Any help is much appreciated!

Cheers,

John

 

[john_liquid]

Any ideas?