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

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
'       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
Do
'                   Link to each cell with an occurence of {MyVal}
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
End Sub


## migrated from stackoverflow.comMar 28 '17 at 17:48

This question came from our site for professional and enthusiast programmers.

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

• Thank you for this suggestion. Sounds like a viable option, although I am not sure how to implement this? I tried to insert the code using VBA but it doesn't like it and I'm not sure why. – ShaunHill Mar 25 '17 at 22:29
• OK, lets fix it. What's the problem? – Absinthe Mar 25 '17 at 23:25
• Thanks for your reply. How do I use this code? Do I go into Excel VBA and go through the menu 'Insert' > 'Module' and then paste? If so, what next to make it run? Would the code provided replace the entire code I originally pasted? – ShaunHill Mar 26 '17 at 6:15
• I should mention that here could be several results for one search query and all of those should be shown at the same time. – ShaunHill Mar 26 '17 at 6:39
• Put the function into any module. It will return the cell with a match as a range. Replace your Set rCell = .Find with Set rCell = MatchCell(wks). Since this question has been closed I can't expand on finding multiple results but look closely at how my code works - you'll figure it out. – Absinthe Mar 26 '17 at 9:12