This VBA script automates the process of searching for a specific text within
multiple Excel files stored in a selected parent folder and all its subfolders. It
begins by prompting the user to choose a parent directory and enter the search
text. A new worksheet is then created to store the results, including the workbook
name, worksheet name, cell location, and the text found.
The script uses a FileSystemObject to navigate through all subfolders and identify
Excel files with extensions .xls, .xlsx, and .xlsm. For each file, it opens the
workbook in read-only mode and searches through all sheets using the Find method to
locate multiple occurrences of the specified text. The results are recorded
dynamically in the output worksheet.
To ensure efficiency and prevent infinite loops, the script properly handles the
FindNext function, ensuring that all instances of the search text are captured.
Once all files have been scanned, the workbooks are closed without saving any
changes, and the results sheet is formatted for better readability. The script
includes error handling mechanisms and automatic cleanup of objects to prevent
memory leaks. Upon completion, a message box notifies the user that the search is
finished. This makes the script an efficient tool for searching large numbers of
Excel files spread across multiple folders.
-----------------------------------------------------------------------------------
-----------------------------------------------------------------------------------
----------------------------------------------------------------
Key Features:
✅ Processes all subfolders within the selected directory.
✅ Works with multiple Excel file formats (.xls, .xlsx, .xlsm).
✅ Handles multiple occurrences of the search text in a worksheet.
✅ Prevents infinite loops using FindNext logic.
✅ Error handling and cleanup ensure smooth execution.
-----------------------------------------------------------------------------------
-----------------------------------------------------------------------------------
----------------------------------------------------------------
Sub SearchFilesInSubfolders()
Dim fileSystem As Object
Dim searchText As String
Dim folderPath As String
Dim outputSheet As Worksheet
Dim lastRow As Long
Dim folderDialog As FileDialog
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Prompt user to select the parent folder
Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
folderDialog.Title = "Select Parent Folder"
If folderDialog.Show = -1 Then
folderPath = folderDialog.SelectedItems(1)
Else
MsgBox "No folder selected. Exiting.", vbExclamation
Exit Sub
End If
' Prompt user to enter the search text
searchText = InputBox("Enter the text to search for:", "Search Text")
If searchText = "" Then
MsgBox "No search text entered. Exiting.", vbExclamation
Exit Sub
End If
' Create a new worksheet to store the results
Set outputSheet = Worksheets.Add
lastRow = 1
With outputSheet
' Add headers to the result sheet
.Cells(lastRow, 1) = "Workbook"
.Cells(lastRow, 2) = "Worksheet"
.Cells(lastRow, 3) = "Cell"
.Cells(lastRow, 4) = "Text in Cell"
.Cells(lastRow, 5) = "Link to Cell"
' Initialize FileSystemObject
Set fileSystem = CreateObject("Scripting.FileSystemObject")
' Call recursive function to process all folders
Call SearchInFolder(fileSystem.GetFolder(folderPath), outputSheet,
searchText, lastRow)
' Autofit the columns for better visibility
.Columns("A:E").EntireColumn.AutoFit
End With
MsgBox "Search Complete"
ExitProcedure:
' Cleanup
Set outputSheet = Nothing
Set fileSystem = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbExclamation
Resume ExitProcedure
End Sub
' **Recursive Function to Search in a Given Folder and All Subfolders**
Sub SearchInFolder(targetFolder As Object, outputSheet As Worksheet, searchText As
String, ByRef lastRow As Long)
Dim fileName As String
Dim currentWorkbook As Workbook
Dim currentSheet As Worksheet
Dim foundCell As Range
Dim firstAddress As String
Dim filePath As String
Dim linkFormula As String
Dim subFolder As Object
' Search all Excel files in the folder
fileName = Dir(targetFolder.Path & "\*.xls*")
Do While fileName <> ""
' Construct the full file path
filePath = targetFolder.Path & "\" & fileName
' Open the current workbook
Set currentWorkbook = Workbooks.Open(Filename:=filePath, UpdateLinks:=0,
ReadOnly:=True, AddToMRU:=False)
' Loop through each worksheet in the current workbook
For Each currentSheet In currentWorkbook.Worksheets
' Find the search text in the used range of the current worksheet
Set foundCell = currentSheet.UsedRange.Find(What:=searchText,
LookAt:=xlPart, MatchCase:=False)
If Not foundCell Is Nothing Then
firstAddress = foundCell.Address
' Loop to find all occurrences of the search text
Do
If foundCell Is Nothing Then Exit Do
lastRow = lastRow + 1
outputSheet.Cells(lastRow, 1) = currentWorkbook.Name
outputSheet.Cells(lastRow, 2) = currentSheet.Name
outputSheet.Cells(lastRow, 3) = foundCell.Address
outputSheet.Cells(lastRow, 4) = foundCell.Value
' Correct Hyperlink Formula
linkFormula = "=HYPERLINK(""" & filePath & """,""Open File"")"
outputSheet.Cells(lastRow, 5).Formula = linkFormula
' Find next occurrence
Set foundCell = currentSheet.Cells.FindNext(After:=foundCell)
Loop While Not foundCell Is Nothing And foundCell.Address <>
firstAddress
End If
Next currentSheet
' Close the current workbook without saving changes
currentWorkbook.Close False
fileName = Dir
Loop
' **Recursively Search All Subfolders**
For Each subFolder In targetFolder.SubFolders
Call SearchInFolder(subFolder, outputSheet, searchText, lastRow)
Next subFolder
End Sub
