Untitled

Sub SearchPartNumberInDirectoryAndSubfolders()
    Dim folderPath As String
    Dim partNumber As String
    Dim fileDialog As FileDialog
    Dim found As Boolean
    Dim resultRow As Long
    
    ' Initialize flag for found parts
    found = False
    
    ' Open a folder picker dialog for the user to select the directory
    Set fileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    fileDialog.Title = "Select Folder Containing Excel Files"
    
    ' If the user selects a folder, proceed
    If fileDialog.Show = -1 Then
        folderPath = fileDialog.SelectedItems(1) & "\"
    Else
        MsgBox "No folder selected. Exiting...", vbExclamation
        Exit Sub
    End If
    
    ' Prompt the user to enter the part number to search for
    partNumber = InputBox("Enter the part number to search for:", "Search Part Number")
    
    ' Ensure part number is entered
    If partNumber = "" Then
        MsgBox "No part number entered. Exiting...", vbExclamation
        Exit Sub
    End If
    
    ' Add a new worksheet for results or clear existing one
    Dim resultSheet As Worksheet
    On Error Resume Next
    Set resultSheet = ThisWorkbook.Sheets("Search Results")
    On Error GoTo 0
    If resultSheet Is Nothing Then
        Set resultSheet = ThisWorkbook.Sheets.Add
        resultSheet.Name = "Search Results"
    Else
        resultSheet.Cells.Clear ' Clear existing results
    End If
    
    ' Set headers for results
    resultSheet.Cells(1, 1).Value = "File Name"
    resultSheet.Cells(1, 2).Value = "Sheet Name"
    resultSheet.Cells(1, 3).Value = "Cell Address"
    resultRow = 2 ' Start writing results from the second row
    
    ' Search in the selected folder and its subfolders
    SearchInFolder folderPath, partNumber, found, resultSheet, resultRow
    
    ' If no part numbers were found, show a message
    If Not found Then
        MsgBox "Part number " & partNumber & " not found in any files.", vbExclamation
    Else
        MsgBox "Search completed. Results saved in the 'Search Results' sheet.", vbInformation
    End If
End Sub

Sub SearchInFolder(ByVal folderPath As String, ByVal partNumber As String, ByRef found As Boolean, ByRef resultSheet As Worksheet, ByRef resultRow As Long)
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim foundCell As Range
    Dim searchRange As Range
    Dim subfolder As String
    
    ' Get the first Excel file in the selected directory
    fileName = Dir(folderPath & "*.xls*") ' Search for .xls and .xlsx files
    
    ' Loop through all Excel files in the directory
    Do While fileName <> ""
        ' Open the workbook
        Set wb = Workbooks.Open(folderPath & fileName)
        
        ' Loop through all worksheets in the workbook
        For Each ws In wb.Worksheets
            ' Define the range to search (you can specify specific columns/rows if needed)
            Set searchRange = ws.UsedRange
            
            ' Search for the part number in the defined range
            Set foundCell = searchRange.Find(What:=partNumber, LookIn:=xlValues, LookAt:=xlPart)
            
            ' If the part number is found
            If Not foundCell Is Nothing Then
                found = True ' Set found flag to True
                
                ' Save the result in the results sheet
                resultSheet.Cells(resultRow, 1).Value = fileName
                resultSheet.Cells(resultRow, 2).Value = ws.Name
                resultSheet.Cells(resultRow, 3).Value = foundCell.Address
                resultRow = resultRow + 1 ' Move to the next row for the next result
            End If
        Next ws
        
        ' Close the workbook without saving
        wb.Close SaveChanges:=False
        
        ' Move to the next file in the directory
        fileName = Dir
    Loop
    
    ' Get the first subfolder in the directory
    subfolder = Dir(folderPath & "*", vbDirectory)
    
    ' Loop through each subfolder
    Do While subfolder <> ""
        ' Avoid current and parent directory references
        If subfolder <> "." And subfolder <> ".." Then
            ' Check if it's a folder
            If (GetAttr(folderPath & subfolder) And vbDirectory) = vbDirectory Then
                ' Recursively search in the subfolder
                SearchInFolder folderPath & subfolder & "\", partNumber, found, resultSheet, resultRow
            End If
        End If
        subfolder = Dir
    Loop
End Sub