This article demonstrates macros that allow you to search for a text string(s) in multiple worksheets and workbooks located in a folder or a subfolder.

1. Search all workbooks in a folder and subfolders using one search string

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.

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)
    
    '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.

Get the Excel file

Search-multiple-workbooks-in-a-folder-and-sub-foldersv5.xlsm

Back to top

2. Search all workbooks in a folder and subfolders using multiple search strings

'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)
 
    'Show dialog box and ask for a cell range
    Set RNG = Application.InputBox(Prompt:="Select a cell range containing search strings" _
, Title:="Select a range", Default:=ActiveCell.Address, Type:=8)
      
    '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 "Search string" to cell "F3"
    WS.Range("F3") = "Search string"
      
    '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
 
                'Iterate through all cells in variable RNG
                    For Each Str In RNG
  
                        '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"

                                'Save search string  to the first empty cell in column F in worksheet WS
                                WS.Range("F1").Offset(Lrow, 0).Value = Str
  
                                '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 the next str 
                Next Str
 
                '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

Back to top

3. Where to put the code?

1. Press shortcut keys Alt + F11 to open the Visual Basic Editor (VBE).
2. Press the left mouse button on "Insert" on the top menu, see the image above.
3. Press the left mouse button on "Module" to insert a module to your workbook.
4. A new module named Module1 is now shown in the "Project Explorer", see the image above.
5. Copy and paste the VBA code to the code module window.
6. Go back to Excel.

Back to top

3.1 How to run the macro

1. Press Alt + F8 to open the macro dialog box.
2. Select macro named "SearchWKBooksSubFolders".
3. Press with the left mouse button on button "Run".

3.2 How to use the macro

The following steps explain how to use the SearchWKBooksSubFolders described in section 2.

1. A dialog box opens asking for a folder to use.
2. A dialog box shows up asking for a cell range containing the search strings.
3. The macro iterates through all workbooks in the selected folder looking for the search strings.
4. A worksheet is created and search results are presented. The image below shows an example.
   

Back to top