Show all full/partial search matches in the first worksheet from other worksheets

Question

Search and display all instances of a full/partial match in the first worksheet from all the other worksheets in the workbook after running a macro to clear formatting of previous search results.

I have data in over 1000 cells in one workbook, spread over 10 worksheets that I am able to search through using a button.

If I use find and replace the data is found within seconds, but using the button it takes a little longer. The idea is that it is much more user friendly and reports the results into one of the worksheets and the next time you click the search button it removes the search results and all formatting.

Can someone please tell me if there is anything I can do to speed it up?

The workbook contains several worksheets with data and each worksheet has different headers. Within the search page, I would like to include the headers at the top of each list of results and then insert a blank row between the search results of each sheet on the search page but I'm not sure how this should be implemented?

Sub Set_Search()
Call Reset1
 '   Object variables
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
 '   {i} will act as our counter
Dim i As Long
 '   Use an input box to type in the search criteria
Dim MyVal As String
MyVal = InputBox("Enter the full name of an individual, department, organisation or area that you wish to contact.", "Contact Search", "")
 '   if we don't have anything entered, then exit the procedure
If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'       Add a heading to the sheet with the specified search value
With Cells(1, 1)
.Value = "Found '" & MyVal & "' in the following cells:" & vbCrLf & "(click below to view the original data)"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
    With Selection.Font
         .Name = "Arial"
         .FontStyle = "Regular"
         .Size = 10
    End With
i = 2
 '       Begin looping:
 '       We are checking all the Worksheets in the Workbook
For Each wks In ActiveWorkbook.Worksheets
     If wks.Name <> "Search" Then
     '       We are checking all cells, we don't need the SpecialCells method
     '       the Find method is fast enough
        With wks.Range("A:G")
         '           Using the find method is faster:
         '           Here we are checking column "A:G" that only have {myVal} partially
            Set rCell = .Find(MyVal, , , xlPart, xlByColumns, xlNext, False)
         '           If something is found, then we keep going
            If Not rCell Is Nothing Then
             '               Store the first address
                fFirst = rCell.Address
                Do
                 '                   Link to each cell with an occurence of {MyVal}
                    rCell.Hyperlinks.Add Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
                    wks.Range("A" & rCell.Row & ":I" & rCell.Row).Copy Destination:=Cells(i, 2)
                    Set rCell = .FindNext(rCell)
                    i = i + 1 'Increment our counter
                Loop While Not rCell Is Nothing And rCell.Address <> fFirst
            End If
        End With
     End If
Next wks
 '   Explicitly clear memory
Set rCell = Nothing
 '   If no matches were found, let the user know
If i = 2 Then
    MsgBox "No results containing your search term were found." & vbCrLf & "" & vbCrLf & "Your search for '" & MyVal & "' did not match any exising data." & vbCrLf & "" & vbCrLf & "These contact details will be added if you send an email to me.", 64, "Contact Search"
    Cells(1, 1).Value = ""
End If
 '   Reset application settings
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

The Find method is pretty quick but has some overhead due to all the find options e.g. whole cells, match case etc.

In this case it would be quicker to put the search data into an array and iterate that to find your value. e.g (written here, untested):

Function MatchCell (ws as Worksheet) as Range

Dim sourceData() as variant
Dim lastRow as long, x as long, y as long

lastRow = ws.Range("A1000000").end(xlUp).row ' you may want to adjust this if you don't know that column A will represent all used rows
sourceData = ws.range("A1:G" & lastRow).value ' again, adjust to suit

for x = 1 to ubound(sourceData) ' loop the first dimension

   for y = 1 to ubound(sourcedata, 2) ' loop the 2nd dimension

      if sourceData(x, y) = myVal then
         MatchCell = ws.Cells(x, y) ' the row is x, the column is y
         Exit Function ' escape the loop/function once the value is found
      End If

   next y

next x

End Function