Option Explicit 
 
Sub QuickSearch() 
     '   Object variables
    Dim wks As Excel.Worksheet 
    Dim rCell As Excel.Range 
     
     
    Dim szFirst As String 
     
     '   {i} will act as our counter
    Dim i As Long 
     
     
     
     '   bTag is our switch to determine if we highlight cells or not
     '   Initially set to true
    Dim bTag As Boolean 
    bTag = True 
     
     
     
     '   Use an input box to type in the search criteria
    Dim szLookupVal As String 
    szLookupVal = InputBox("What are you searching for", "Search-Box", "") 
     
     
     
     '   if we don't have anything entered, then exit the procedure
    If szLookupVal = "" Then Exit Sub 
     
     
     
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
     
     
     
     '       =============================================================
     '       Add the sheet for linking {Check for existence first}
     '       if it exists, get rid of it
    For Each wks In ActiveWorkbook.Worksheets 
        If wks.Name = "Found it here" Then 
            wks.Delete 
        End If 
    Next wks 
     
     
     '       Add the sheet
    Sheets.Add ActiveSheet 
     
     
     '       Re-name the sheet
    ActiveSheet.Name = "Found it here" 
     
     
     '       Add a heading to the sheet with the specified search value
    With Cells(1, 1) 
        .Value = "Found " & szLookupVal & " in the cells below:" 
        .EntireColumn.AutoFit 
        .HorizontalAlignment = xlCenter 
    End With 
     '       =============================================================
     
     
     '       Reselect the previous sheet
    ActiveSheet.Next.Select 
     
     
     
     '       =============================================================
     '       Prompt if you want to shade occurences in the cells
     '       *Highlighted cells will need to be manually removed*
    If MsgBox("Would you like to highlight all found occurences also?", vbYesNo, _ 
    "Highlight Cells") = vbNo Then 
         
         
         '       If shaded cells are not called for, set out boolean switch to FALSE
        bTag = False 
         
    End If 
     '       =============================================================
     
     
     
    i = 2 
     '       Begin looping:
     '       We are checking all the Worksheets in the Workbook
    For Each wks In ActiveWorkbook.Worksheets 
         
         
         '       We are checking all cells, we don't need the SpecialCells method
         '       the Find method is fast enough
        With wks.Cells 
             
             
             '           Using the find method is faster:
             '           Here we are checking for cells that only have {szLookupVal} explicitly
             '           We are not matching case, so if it's a word, it can be {Hello, hello, HELLO}
             '           The optional Find properties can be modified to adjust to different kinds of searches
             '           Like finding a cell with a text string that contains part of a word, or has the word
             '           contained somewhere within the text string
            Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False) 
             
             
             '           If something is found, then we keep going
            If Not rCell Is Nothing Then 
                 
                 
                 '               Store the first address
                szFirst = rCell.Address 
                 
                 
                Do 
                     
                     '                   Link to each cell with an occurence of {szLookupVal}
                    rCell.Hyperlinks.Add Sheets("Found it here").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address 
                     
                     
                     '                   We check our boolean trigger value, and decide if we are coloring cells
                     '                   or are we just adding links
                    Select Case bTag 
                         
                    Case True 
                         
                        rCell.Interior.ColorIndex = 19 
                         
                    End Select 
                     
                    Set rCell = .FindNext(rCell) 
                     
                    i = i + 1 'Increment our counter
                     
                Loop While Not rCell Is Nothing And rCell.Address <> szFirst 
                 
                 
            End If 
             
        End With 
         
    Next wks 
     
     
     '   Explicitly clear memory
    Set rCell = Nothing 
     
     
     '   If no matches were found, let the user know
     '   and remove the link sheet
    If i = 2 Then 
        MsgBox "The value {" & szLookupVal & "} was not found on any sheet", 64, "No Matches" 
        Sheets("Found It Here").Delete 
    End If 
     
     
     '   Reset application settings
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
End Sub