VBA Search all sheets for double clicked cell value

Question

The other day I learned how to use VBA to double click a cell in sheet1 and then it would jump to the cell with that same value in Sheet 2.

I have a similar report now, except this time I need to double click a cell in Sheet1 and then search every sheet in the same workbook for that value.

The code I have for the first scenario that works is here: In ThisWorkbook:

Private Sub Workbook_SheetBeforeDoubleClick _
(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

If Len(Target.Value) = 0 Then Exit Sub

'If the double-clicked cell isn't in column A, we exit.
If Target.Column <> 1 Then Exit Sub

'Calls the procedure FindName in Module1 and passes the cell content
Module1.FindName Target.Value

End Sub

In Module1:

Sub FindName(ByVal sName As String)
'Finds and activates the first cell
'with the same content as the double-clicked cell. sName
'is the passed cell content.
Dim rColumn As Range
Dim rFind As Range

'Activate the sheet Contact Data.
Worksheets("All Data").Activate

'Set the range rColumn = column B
Set rColumn = Columns("B:B")

'Search column B
Set rFind = rColumn.Find(sName)

'If found the cell is activated.
If Not rFind Is Nothing Then
   rFind.Activate
Else
   'If not found activate cell A1
   Range("A1").Activate
End If

Set rColumn = Nothing
Set rFind = Nothing

End Sub

If anyone knows how to maybe create a worksheet loop in this so that it will look for the value in every worksheet I will be so grateful!

Thanks! Emmily My Source for Previous code: http://www.sitestory.dk/excel_vba/hyperlinks-alternative.htm

Answer 1

Here you go. Will search all sheets and return a message if nothing is found. Will activate cell if it is found.

Sub FindName(ByVal sName As String)

    'Finds and activates the first cell in any sheet (moving left-to-right)
    'with the same content as the double-clicked cell. sName
    'is the passed cell content.
    Dim rFind As Range
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets

        Set rFind = ws.Columns(2).Find(sName, lookat:=xlWhole) ' look for entire match, set to xlPart to search part of cell ... 2 is column B.

        If Not rFind Is Nothing Then
            Dim bFound As Boolean
            bFound = True
            ws.Activate
            rFind.Select
            Exit For
        End If

    Next

    If Not bFound Then MsgBox sName & " not found in any sheet."

End Sub