'******************************************************
 'This goes to the ThisWorkbook Module:
 '*******************************************************
Option Explicit 
Private Sub Workbook_Open() 
    Application.OnKey "^%F", "ShowSearchDialog" 'Assign shortcut keys
    Application.OnKey "^%f", "ShowSearchDialog" 
End Sub 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Application.OnKey "^%F" 'Restore shortcut keys
    Application.OnKey "^%f" 
    On Error Resume Next 
    ResetCellColor 
    Unload ufmSearch 
End Sub 
 
 '************************************************************
 'This goes to the General purpose  Module:
 '************************************************************
Option Explicit 
Public Arr() As String 
Public intCurSheet, intNextSheet, intPrevSheet As Integer 
Public curCell, nextCell, prevCell As Range 
Public lastColor As Variant 
Sub ShowSearchDialog() 
     '-----------------------------------
     'Show the Search window
     '-----------------------------------
    Load ufmSearch 
    ufmSearch.Show vbModeless 
End Sub 
Function NextCellExists(ByVal cell As Range) As Boolean 
     '----------------------------------------
     'Check current Sheet for next cell.
     'If not found move to next Sheet.
     'If found store the Sheet's index.
     '----------------------------------------
    With Worksheets(Arr(intCurSheet)) 
        Set nextCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, After:=cell, _ 
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _ 
        SearchDirection:=xlNext, MatchCase:=False) 
         'If found
        If Not nextCell Is Nothing And nextCell.Address <> cell.Address And _ 
        (nextCell.Row > cell.Row Or _ 
        (nextCell.Row = cell.Row And nextCell.Column > cell.Column)) Then 
             
            intNextSheet = intCurSheet 'Update the next Worksheet's index
            NextCellExists = True 
             'If not foud
        Else 
             'Keep searching in the next Sheet
            If intNextSheet < UBound(Arr) Then 
                intNextSheet = intNextSheet + 1 
                If NextCellInNextSheet Then NextCellExists = True 
            Else 
                ufmSearch.btnNext.Enabled = False 
            End If 
        End If 
    End With 
End Function 
Function NextCellInNextSheet() As Boolean 
     '---------------------------------------
     'Check rest of sheets for next occurence
     '---------------------------------------
    Dim i As Integer 
    For i = intNextSheet To UBound(Arr) 
        With Worksheets(Arr(i)) 
            Set nextCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, _ 
            After:=.Cells(.Rows.Count, .Columns.Count), _ 
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _ 
            SearchDirection:=xlNext, MatchCase:=False) 
            If Not nextCell Is Nothing Then Exit For 
        End With 
    Next 'I
     'If found
    If Not nextCell Is Nothing Then 
        intNextSheet = i 'Update the next Worksheet's index
        NextCellInNextSheet = True 
    End If 
End Function 
Function PreviousCellExists(ByVal cell As Range) As Boolean 
     '----------------------------------------
     'Check current Sheet for previous cell.
     'If not found move to previous Sheet.
     'If found store the Sheet's index.
     '----------------------------------------
    With Worksheets(Arr(intCurSheet)) 
        Set prevCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, After:=cell, _ 
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _ 
        SearchDirection:=xlPrevious, MatchCase:=False) 
         'If found
        If Not prevCell Is Nothing And prevCell.Address <> cell.Address And _ 
        (prevCell.Row < cell.Row Or _ 
        (prevCell.Row = cell.Row And prevCell.Column < cell.Column)) Then 
             
            intPrevSheet = intCurSheet 'Update the previous Worksheet's index
            PreviousCellExists = True 
             'If not foud
        Else 
             'Keep searching in the previous Sheet
            If intPrevSheet > LBound(Arr) Then 
                intPrevSheet = intPrevSheet - 1 
                If PreviousCellInPreviousSheet Then PreviousCellExists = True 
            Else 
                ufmSearch.btnPrevious.Enabled = False 
            End If 
        End If 
    End With 
End Function 
Function PreviousCellInPreviousSheet() As Boolean 
     '---------------------------------------
     'Check rest of sheets for previous occurence
     '---------------------------------------
    Dim i As Integer 
    For i = intPrevSheet To LBound(Arr) Step -1 
        With Worksheets(Arr(i)) 
            Set prevCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, After:=.Range("A1"), _ 
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _ 
            SearchDirection:=xlPrevious, MatchCase:=False) 
            If Not prevCell Is Nothing Then Exit For 
        End With 
    Next 'I
     'If found
    If Not prevCell Is Nothing Then 
        intPrevSheet = i 'Update the next Worksheet's index
        PreviousCellInPreviousSheet = True 
    End If 
End Function 
Sub ResetCellColor() 
     '-----------------------------------
     'Reset the original color of the cell
     '-----------------------------------
    On Error Resume Next 
    If Not curCell Is Nothing Then curCell.Interior.ColorIndex = lastColor 
End Sub 
 
 '**************************************************
 'This goes to the Userform (ufmSearch) Module
 '***************************************************
Option Explicit 
 '------------------------------------------------
 'Pop-up search window (through keyboard shortcut)
 '------------------------------------------------
Private Sub UserForm_Initialize() 
    Me.txtSearch.SelectionMargin = False 
    Me.txtSearch.TabIndex = 0 
    Me.btnFindFirst.TabIndex = 1 
    Me.btnFindFirst.TakeFocusOnClick = False 
    Me.btnPrevious.TabIndex = 2 
    Me.btnPrevious.TakeFocusOnClick = False 
    Me.btnNext.TabIndex = 2 
    Me.btnNext.TakeFocusOnClick = False 
    Me.btnExit.TabIndex = 3 
    Me.btnExit.TakeFocusOnClick = False 
    Me.btnPrevious.Enabled = False 
    Me.btnNext.Enabled = False 
    Me.btnFindFirst.Default = True 
    Me.btnExit.Cancel = True 
End Sub 
Private Sub UserForm_Activate() 
    Dim i As Integer, Sht As Worksheet 
     '----------------------------------------------------------
     'First load an array with all the to-be-searched worksheets
     '----------------------------------------------------------
    For Each Sht In Worksheets 
        i = i + 1 
        ReDim Preserve Arr(1 To i) 
        Arr(i) = Sht.Name 
    Next 
    Me.txtSearch.SetFocus 
End Sub 
Private Sub btnFindFirst_Click() 
     '--------------------------------------------------------
     'Find first occurence. If found, select. Else notify.
     '--------------------------------------------------------
    Dim i As Integer 
     
     'Exit if nothing has been entered
    If Trim(Me.txtSearch.Text) = "" Then Exit Sub 
     
    intCurSheet = 1 
     'Search in each Worksheet
    For i = intCurSheet To UBound(Arr) 
        With Worksheets(Arr(i)) 
            Set curCell = .Cells.Find(What:=Me.txtSearch.Text, _ 
            After:=.Cells(.Rows.Count, .Columns.Count), _ 
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _ 
            SearchDirection:=xlNext, MatchCase:=False) 
            If Not curCell Is Nothing Then Exit For 
        End With 
    Next 'I
     
     'If found
    If Not curCell Is Nothing Then 
        ResetCellColor 
        curCell.Parent.Activate 
        lastColor = curCell.Interior.ColorIndex 
        curCell.Interior.ColorIndex = 4 
        Set prevCell = curCell 
        curCell.Select 
        intCurSheet = i 'Store the current Worksheet's index
         
         '---------------------------------
         'Check existence of next occurence
         '---------------------------------
        If NextCellExists(curCell) Then 
            Me.btnNext.Enabled = True 
        End If 
         'If not found, notify
    Else 
        MsgBox "Entered string not found", , "Search complete" 
    End If 
End Sub 
Private Sub btnNext_Click() 
     '--------------------------------------------------------------
     'Select the next cell and update the current Worksheet's index
     '--------------------------------------------------------------
    ResetCellColor 
    Set prevCell = curCell 
    intPrevSheet = intCurSheet 
    Set curCell = nextCell 
    intCurSheet = intNextSheet 
    curCell.Parent.Activate 
    lastColor = curCell.Interior.ColorIndex 
    curCell.Interior.ColorIndex = 4 
    curCell.Select 
     
     'Enable the FindPrevious button
    Me.btnPrevious.Enabled = True 
     
     'Enable/Disable the FindNext button
    Me.btnNext.Enabled = IIf(NextCellExists(curCell), True, False) 
End Sub 
Private Sub btnPrevious_Click() 
     '--------------------------------------------------------------
     'Select the next cell and update the current Worksheet's index
     '--------------------------------------------------------------
    ResetCellColor 
    Set nextCell = curCell 
    intNextSheet = intCurSheet 
    Set curCell = prevCell 
    intCurSheet = intPrevSheet 
    curCell.Parent.Activate 
    lastColor = curCell.Interior.ColorIndex 
    curCell.Interior.ColorIndex = 4 
    curCell.Select 
     
     'Enable the FindPrevious button
    Me.btnNext.Enabled = True 
     
     'Enable/Disable the FindPrevious button
    Me.btnPrevious.Enabled = IIf(PreviousCellExists(curCell), True, False) 
End Sub 
Private Sub txtSearch_Change() 
     '------------------------------------------------------
     'In case new string is entered while search is running,
     'allow only "Find first" (start from beginning)
     '------------------------------------------------------
    Me.btnNext.Enabled = False 
    Me.btnPrevious.Enabled = False 
End Sub 
Private Sub btnExit_Click() 
    ResetCellColor 
    Unload Me 
End Sub 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 
    If CloseMode = vbFormControlMenu Then ResetCellColor 
End Sub