Help With FindAll Function To Display Entire Row of Found Item.

[aedctalk]

I modifed the below code to suit my program.

It searaches whole workbook (mine is for item numbers for parts we use in our facility & descriptions of the parts).. for a word then displays it all findings on a reslults page.

However there is one element that could make things so much better. That is if.. on the search results page if it could display the entire row where "found word" is in .. instead of just displaying the cell text where the word was found

Is there any way to modify this code to do that? Its a little above my knowlege :/

Public Sub FindAll(Search As String, Reset As Boolean)
     
    Dim WB              As Workbook
    Dim WS              As Worksheet
    Dim Cell            As Range
    Dim Prompt          As String
    Dim Title           As String
    Dim FindCell()      As String
    Dim FindSheet()     As String
    Dim FindWorkBook()  As String
    Dim FindPath()      As String
    Dim FindText()      As String
    Dim Counter         As Long
    Dim FirstAddress    As String
    Dim Path            As String
    Dim MyResponse      As VbMsgBoxResult
     
    If Search = "" Then
        Prompt = "What do you want to search for in the worbook: " & vbNewLine & vbNewLine & Path
        Title = "Search Criteria Input"
         'Delete default search term if required
        Search = Range("G3").Value
        If Search = "" Then
            GoTo Canceled
        End If
    End If
     
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
     
     'Save found addresses and text into arrays
    On Error Resume Next
    Set WB = ActiveWorkbook
    If Err = 0 Then
        On Error GoTo 0
        For Each WS In WB.Worksheets
             'Omit results page from search
            If WS.Name <> "FindWord" Then
                With WB.Sheets(WS.Name).Cells
                    Set Cell = .Find(What:=Search, LookIn:=xlValues, LookAt:=xlPart, _
                    MatchCase:=False, SearchOrder:=xlByColumns)
                    If Not Cell Is Nothing Then
                        FirstAddress = Cell.Address
                        Do
                            Counter = Counter + 2
                            ReDim Preserve FindCell(2 To Counter)
                            ReDim Preserve FindSheet(2 To Counter)
                            ReDim Preserve FindWorkBook(2 To Counter)
                            ReDim Preserve FindPath(2 To Counter)
                            ReDim Preserve FindText(2 To Counter)
                            FindCell(Counter) = Cell.Address(False, False)
                            FindText(Counter) = Cell.Text
                            FindSheet(Counter) = WS.Name
                            FindWorkBook(Counter) = WB.Name
                            FindPath(Counter) = WB.FullName
                            Set Cell = .FindNext(Cell)
                        Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
                    End If
                End With
            End If
        Next
    End If
    On Error GoTo 0
     'Response if no text found
    If Counter = 0 Then
        MsgBox Search & " was not found.", vbInformation, "Zero Results For Search"
        Exit Sub
    End If
     
     'Create FindWord sheet in does not exist
    On Error Resume Next
    Sheets("FindWord").Select
    If Err <> 0 Then
        Debug.Print Err
         'error occured so clear it
        Err.Clear
        Sheets.Add.Name = "FindWord"
        Sheets("FindWord").Move After:=Sheets(Sheets.Count)
         'Run macro to add code to ThisWorkbook
        AddSheetCode
    End If
     'Write hyperlinks and texts to FindWord
    Range("B12:J270").ClearContents


 
For Counter = Counter = 1 To UBound(FindCell)
        ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & Counter + 10), _
        Address:="", SubAddress:=FindSheet(Counter) & "!" & FindCell(Counter), TextToDisplay:="VIEW ITEM"
        
        Range("D" & Counter + 10).Value = FindText(Counter) & Chr(10) & Chr(10) & "Found In Cell ' " & FindCell(Counter) & " ' in ' " & FindSheet(Counter) & " '"
        
       
  
        
        
    Next Counter
        
  
Canceled:
     
    Set WB = Nothing
    Set WS = Nothing
    Set Cell = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    
     
End Sub