Search and display results to listbox

Hello,

I have a userform1 that allows users to search :

Data on sheet2

and results on sheet1
userform1.PNGData.PNGResults.PNG


End user inputs 142 and search, this should display results in listbox that have all matching title : 142. with the total of 7 columns

The end user would be able to select the correct one and add the results with a click of a button to sheet1 for print.

Curently my code consist of msgbox but the clicking is not helpful.

Sub Button1_Click()

    Dim titleSearch As String
    Dim returnValue As String
    Dim rowVal As Long
    
tryagain:
    titleSearch = InputBox("Please Enter a Title")
    
    If Len(titleSearch) = 0 Then
        MsgBox ("Please Enter a Company Name"), vbCritical, ("Company Required")
        Exit Sub
    End If
    
    With Sheets("Data")
        For x = 1 To .Cells(Rows.count, "A").End(xlUp).Row Step 1
            If .Cells(x, 1) = titleSearch Then
                returnValue = _
                    "Title:   " & vbTab & .Cells(x, 1) & vbNewLine & _
                    "Co:      " & vbTab & .Cells(x, 2) & vbNewLine & _
                    "Name:    " & vbTab & .Cells(x, 3) & vbNewLine & _
                    "Address: " & vbTab & .Cells(x, 4) & vbNewLine & _
                    "City:    " & vbTab & .Cells(x, 5) & vbNewLine & _
                    "State:   " & vbTab & .Cells(x, 6) & vbNewLine & _
                    "Zip:     " & vbTab & .Cells(x, 7)
                
                Select Case MsgBox("Match Found! Is this the correct address?" & _
                                    vbNewLine & returnValue, vbYesNo)
                    Case vbYes
                        rowVal = x
                        GoTo matchFound
                    Case vbNo
                End Select
            End If
                
        Next x
    
RecordResponse = MsgBox("End of Title Search. Would you like to add?", vbYesNo + vbCritical)
If RecordResponse = vbYes Then
UserForm2.Show
Exit Sub
Else
Exit Sub




End If


matchFound:
        Sheets("Output").Range("B8") = .Cells(rowVal, 2).Value
        Sheets("Output").Range("B9") = .Cells(rowVal, 3).Value
        Sheets("Output").Range("B10") = .Cells(rowVal, 4).Value
        Sheets("Output").Range("B11") = .Cells(rowVal, 5).Value & "  " & .Cells(rowVal, 6) & _
                                            ",   " & .Cells(rowVal, 7)
        
    End With




End Sub

This is fundamentally wrong.

You need a search routine to find your matching entries

Once found the entries are used to populate a list box

Clicking on the listbox should then pull up the selected data.

study this userform:-

What is the purpose of this part of the code?

Private Sub Locator()
Application.ScreenUpdating = False
ASht = ActiveSheet.Name
ACell = CStr(ActiveCell.Address)
End Sub

Private Sub ReLocator()
Sheets(ASht).Select
Range(ACell).Select
Application.ScreenUpdating = True
End Sub

I am getting a Run-Time error '9':
Subscript out of range

shows highlighted

Sheets(Asht).Select

Current Code:

Issues:
1. listbox additem is adding like a text, I need to have columns and set the first column rows with a better understanding for end user
Title, Company,Lastname, Address, City, State, Zipcode with a auto adjust column size if possible?

2. output when data is select from listbox needs to be only on column B8,B9,B10, B11 not being added list a list when selected again.

Private Sub CommandButton3_Click()
UserForm1.Hide
UserForm2.Show
End Sub

Private Sub ListBox1_Click()

Locator

Sheets("Output").Select
Range("C5:C26").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
nr = ActiveCell.Row
CR = Left(ListBox1.Value, InStr(Trim(ListBox1.Value), " ") - 1) * 1
Sheets("Output").Range("C" & nr & ":E" & nr).Value = Sheets("Data").Range("B" & CR & ":D" & CR).Value
Sheets("Output").Range("F" & nr).Value = Sheets("Data").Range("G" & CR).Value
ListBox1.Visible = False

ReLocator

End Sub

Private Sub TextBox1_Change()
findname
End Sub

Private Sub findname()

Locator

If Len(TextBox1.Text) < 4 Then Exit Sub

Sheets("Data").Select
LR = Range("A95536").End(xlUp).Row

  Set rngLook = Range(Cells(1, 2), Cells(LR, 1))

  strValueToPick = TextBox1.Text

On Error Resume Next

'Find NAME IN COLUMN A
    With rngLook
        Set rngFind = .Find(strValueToPick, .Cells(1, 2), LookIn:=xlFormulas, LookAt:=xlWhole)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngPicked = rngFind
            Do
                Set rngPicked = Union(rngPicked, rngFind)
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
    If strFirstAddress = "" Then Exit Sub
    If Not rngPicked Is Nothing Then
        rngPicked.Select
    End If

ListBox1.Clear


For Each c In Selection

ListBox1.AddItem Cells(c, 1).Row & "  " & Cells(c.Row, 2).Value & "  " & Cells(c.Row, 3).Value & "  " & Cells(c.Row, 4).Value & "  " & Cells(c.Row, 5).Value & "  " & Cells(c.Row, 6).Value & "  " & Cells(c.Row, 7).Value

10 Next c
If ListBox1.ListCount = 1 Then ListBox1_Click
ReLocator

Changeflag = 0
End Sub

Private Sub Locator()
Application.ScreenUpdating = False
ASht = ActiveSheet.Name
ACell = CStr(ActiveCell.Address)
End Sub

Private Sub ReLocator()
Sheets(ASht).Select
Range(ACell).Select
Application.ScreenUpdating = True
End Sub