2
\$\begingroup\$

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
\$\endgroup\$

migrated from stackoverflow.com Mar 28 '17 at 17:48

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

4
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – ShaunHill Mar 25 '17 at 22:29
  • \$\begingroup\$ OK, lets fix it. What's the problem? \$\endgroup\$ – Absinthe Mar 25 '17 at 23:25
  • \$\begingroup\$ 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? \$\endgroup\$ – ShaunHill Mar 26 '17 at 6:15
  • \$\begingroup\$ I should mention that here could be several results for one search query and all of those should be shown at the same time. \$\endgroup\$ – ShaunHill Mar 26 '17 at 6:39
  • \$\begingroup\$ 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. \$\endgroup\$ – Absinthe Mar 26 '17 at 9:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.