'Note that almost all the code here relating to the actual "search" can be
 'credited to our very own DRJ (Jacob). See this thread here for more >
 'http://www.vbaexpress.com/forum/showthread.php?t=1017
 '(Take special note of the time I posted & the time Jacob posted {boggle})
 'My contribution was to have a practical application for it to be used for,
 'and then to do the code to extend it to search all sheets and then do all
 'the highlighting/unhighlighting...
 
Option Explicit 
 
Sub SearchAreas() 
     
    Dim ThisAddress$, Found, FirstAddress 
    Dim Lost$, N&, NextSheet& 
    Dim CurrentArea As Range, SelectedRegion As Range 
    Dim Reply As VbMsgBoxResult 
    Dim FirstSheet As Worksheet 
    Dim Ws As Worksheet 
    Dim Wks As Worksheet 
    Dim Sht As Worksheet 
     
    Set FirstSheet = ActiveSheet '< bookmark start sheet
    Lost = InputBox(prompt:="What are you looking for?", _ 
    Title:="Find what?", Default:="*") 
    If Lost = Empty Then End 
    For Each Ws In Worksheets 
        Ws.Select 
        With ActiveSheet.Cells 
            Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues) 
            If FirstAddress Is Nothing Then '< blank sheet
                GoTo NextSheet 
            End If 
            FirstAddress.CurrentRegion.Select 
            Selection.Interior.ColorIndex = 6 '< yellow
             '//colour the 'Lost' font red, cell colour blank
            With Selection 
                Set Found = .Find(What:=Lost, LookIn:=xlValues) 
                If Not Found Is Nothing Then 
                    FirstAddress = Found.Address 
                    Do 
                        Found.Interior.ColorIndex = 3 '< red
                        Found.Font.Bold = True 
                        Found.Font.ColorIndex = 2 
                        Set Found = .FindNext(Found) 
                    Loop While Not Found Is Nothing And Found. _ 
                    Address <> FirstAddress 
                End If 
            End With 
            Reply = MsgBox("Is this the " & Lost & " you're looking for?", _ 
            vbQuestion + vbYesNoCancel, "Current Region") 
             '//restore the 'Lost' font and cell colour
            Set Found = .Find(What:=Lost, LookIn:=xlValues) 
            If Not Found Is Nothing Then 
                FirstAddress = Found.Address 
                Do 
                    Found.Font.Bold = False 
                    Found.Font.ColorIndex = 0 
                    Set Found = .FindNext(Found) 
                Loop While Not Found Is Nothing And Found. _ 
                Address <> FirstAddress 
            End If 
             '//restore the selection colour
            Selection.Interior.ColorIndex = xlNone 
            Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues) 
            If Reply = vbCancel Then End 
             '//dont look further
            If Reply = vbYes Then 
                Set SelectedRegion = Selection 
GoTo Finish: 
            End If 
             '//case=not this one
            ThisAddress = FirstAddress.Address 
            Set CurrentArea = Selection 
            Do 
                If Intersect(CurrentArea, Selection) Is Nothing Then 
                    With Selection.Interior 
                        .ColorIndex = 6 
                        .Pattern = xlSolid 
                    End With 
                     '//colour the 'Lost' font red, cell colour blank
                    With Selection 
                        Set Found = .Find(What:=Lost, LookIn:=xlValues) 
                        If Not Found Is Nothing Then 
                            FirstAddress = Found.Address 
                            Do 
                                Found.Interior.ColorIndex = 3 
                                Found.Font.Bold = True 
                                Found.Font.ColorIndex = 2 
                                Set Found = .FindNext(Found) 
                            Loop While Not Found Is Nothing And Found. _ 
                            Address <> FirstAddress 
                        End If 
                    End With 
                    Reply = MsgBox("Is this the " & Lost & " you're looking for?", _ 
                    vbQuestion + vbYesNoCancel, "Current Region") 
                     '//restore the 'Lost' font and cell colour
                    Set Found = .Find(What:=Lost, LookIn:=xlValues) 
                    If Not Found Is Nothing Then 
                        FirstAddress = Found.Address 
                        Do 
                            Found.Font.Bold = False 
                            Found.Font.ColorIndex = 0 
                            Set Found = .FindNext(Found) 
                        Loop While Not Found Is Nothing And Found. _ 
                        Address <> FirstAddress 
                    End If 
                     '//restore the selection colour
                    Selection.Interior.ColorIndex = xlNone 
                    Set FirstAddress = .Find(What:=Lost, _ 
                    LookIn:=xlValues) 
                    If Reply = vbCancel Then End 
                    If Reply = vbYes Then 
                        Set SelectedRegion = Selection 
GoTo Finish: 
                    End If 
                End If 
                If CurrentArea Is Nothing Then 
                    Set CurrentArea = Selection 
                Else 
                    Set CurrentArea = Union(CurrentArea, Selection) 
                End If 
                Set FirstAddress = .FindNext(FirstAddress) 
                FirstAddress.CurrentRegion.Select 
            Loop While Not FirstAddress Is Nothing And FirstAddress. _ 
            Address <> ThisAddress 
        End With 
NextSheet: 
    Next Ws 
Finish: 
    If Reply = vbYes Then 
        Exit Sub 
    Else 
        FirstSheet.Select 
        MsgBox "Search Completed - Sorry, no more " & Lost & "s", _ 
        vbInformation, "No Region Selected" 
    End If 
End Sub