Author: Oscar Cronquist Article last updated on March 15, 2021

This article demonstrates a macro that allows you to search for a text string in multiple worksheets and workbooks located in folder or a subfolder.

The macro asks for a folder to search in and a search string. It then opens all workbooks, one by one, in the given folder and then continues with subfolders looking for a cell containing the search string.

A new worksheet is populated data describing cells equal to the search string. The folder path, worksheet name, cell address, and a hyperlink is shown if the cell matches the search string.

Simply press with left mouse button on the hyperlink to automatically open the workbook and you will also be taken to the worksheet and cell with the matching search string.

The macro is built on the macro shown in this article:Search all workbooks in a folder . I am happy so many find it useful.

rusl cato asks:
hi thanks for the great macro really makes a hard job much easier, can this be made to search subfolders as well?
thanks
rusl
Matt Durbin asks:
Is there a way to make the search look in subdirectories as well

This is an example of a search i did in c:\temp on my harddrive.

The following VBA macro searches workbooks in a folder and subfolders with file extensions *.xls, *.xlsx and *.xlsm.

'Dimensioning public variable and declare data type
'A Public variable can be accessed from any module, Sub Procedure, Function or Class within a specific workbook.
Public WS As Worksheet

'Name macro and parameters
Sub SearchWKBooksSubFolders(Optional Folderpath As Variant, Optional Str As Variant)

'Dimension variables and declare data types
Dim myfolder As String
Dim a As Single
Dim sht As Worksheet
Dim Lrow As Single
Dim Folders() As String
Dim Folder As Variant

'Redimension array variable
ReDim Folders(0)

'IsMissing returns a Boolean value indicating if an optional Variant parameter has been sent to a procedure.
'Check if FolderPath has not been sent
If IsMissing(Folderpath) Then

    'Add a worksheet
    Set WS = Sheets.Add

    'Ask for a folder to search
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        myfolder = .SelectedItems(1) & "\"
    End With
    
    'Ask for a search string
    Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)
    
    'Stop macro if no search string is entered.
    If Str = "" Then Exit Sub
    
    'Save "Search string:" to cell "A1"
    WS.Range("A1") = "Search string:"

     'Save variable Str to cell "B1"
    WS.Range("B1") = Str

    'Save "Path:" to cell "A2"
    WS.Range("A2") = "Path:"

    'Save variable myfolder to cell "B2"
    WS.Range("B2") = myfolder

    'Save "Folderpath" to cell "A3"
    WS.Range("A3") = "Folderpath"

    'Save "Workbook" to cell "B3"
    WS.Range("B3") = "Workbook"

    'Save "Worksheet" to cell "C3"
    WS.Range("C3") = "Worksheet"

    'Save "Cell Address" to cell "D3"
    WS.Range("D3") = "Cell Address"

    'Save "Link" to cell "E3"
    WS.Range("E3") = "Link"
    
    'Save variable myfolder to variable Folderpath
    Folderpath = myfolder
    
    'Dir returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
    Value = Dir(myfolder, &H1F)

'Continue here if FolderPath has been sent    
Else

    'Check if two last characters in Folderpath is "//"
    If Right(Folderpath, 2) = "\\" Then

        'Stop macro
        Exit Sub
    End If

    'Dir returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
    Value = Dir(Folderpath, &H1F)
End If

'Keep iterating until Value is nothing
Do Until Value = ""

    'Check if Value is . or ..
    If Value = "." Or Value = ".." Then

    'Continue here if Value is not . or ..
    Else

        'Check if Folderpath & Value is a folder
        If GetAttr(Folderpath & Value) = 16 Then

            'Add folder name to array variable Folders
            Folders(UBound(Folders)) = Value

            'Add another container to array variable Folders
            ReDim Preserve Folders(UBound(Folders) + 1)
        
        'Continue here if Value is not a folder
        'Check if file ends with xls, xlsx, or xlsm    
        ElseIf Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then

            'Enable error handling
            On Error Resume Next

            'Check if workbook is password protected
            Workbooks.Open Filename:=Folderpath & Value, Password:="zzzzzzzzzzzz"

            'Check if an error has occurred
            If Err.Number <> 0 Then

                'Write the workbook name and the phrase "Password protected"
                WS.Range("A4").Offset(a, 0).Value = Value
                WS.Range("B4").Offset(a, 0).Value = "Password protected"

                'Add 1 to variable 1
                a = a + 1

                'Disable error handling
                On Error GoTo 0

            'Continue here if an error has not occurred
            Else

                'Iterate through all worksheets in active workbook
                For Each sht In ActiveWorkbook.Worksheets
                        'Expand all groups in sheet
	                sht.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8

                        'Search for cells containing search string and save to variable c
                        Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

                        'Check if variable c is not empty
                        If Not c Is Nothing Then

                            'Save cell address to variable firstAddress
                            firstAddress = c.Address

                            'Do ... Loop While c is not nothing
                            Do

                                'Save row of last non empty cell in column A
                                Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row

                                'Save folderpath to the first empty cell in column A in worksheet WS
                                WS.Range("A1").Offset(Lrow, 0).Value = Folderpath

                                'Save value to the first empty cell in column B in worksheet WS
                                WS.Range("B1").Offset(Lrow, 0).Value = Value

                                'Save worksheet name to  the first empty cell in column C in worksheet WS
                                WS.Range("C1").Offset(Lrow, 0).Value = sht.Name

                                'Save cell address to the first empty cell in column D in worksheet WS
                                WS.Range("D1").Offset(Lrow, 0).Value = c.Address
                                'Insert hyperlink
                                WS.Hyperlinks.Add Anchor:=WS.Range("E1").Offset(Lrow, 0), Address:=Folderpath & Value, SubAddress:= _
                                "'" & sht.Name & "'" & "!" & c.Address, TextToDisplay:="Link"

                                'Find next cewll containing search string and save to variable c
                                Set c = sht.Cells.FindNext(c)

                            'Continue iterate while c is not empty and cell address is not equal to first cell address
                            Loop While Not c Is Nothing And c.Address <> firstAddress
                        End If

                'Continue with next worksheet
                Next sht
            End If

            'Close workbook
            Workbooks(Value).Close False

            'Disable error handling
            On Error GoTo 0
        End If
    End If
    Value = Dir
Loop

'Go through alll folder names and 
For Each Folder In Folders

    'start another instance of macro SearchWKBooksSubFolders (recursive)
    SearchWKBooksSubFolders (Folderpath & Folder & "\")
Next Folder

'Resize column widths
Cells.EntireColumn.AutoFit
End Sub

Microsoft docs: IsMissing | Dir | GetAttr |

Update:
1. The macro expands grouped rows and columns before searching a workbook.
2. There is also now a class module in the workbook below, so if you press with left mouse button on a hyperlink on a sheet and a workbook opens, grouped data will be expanded.
3. Worksheet names containing some specific characters caused "Reference is not valid" if you press with left mouse button on a hyperlink. This is now working.