Untitled

mail@pastecode.io avatar
unknown
plain_text
10 days ago
2.9 kB
3
Indexable
Never
Sub SearchPartNumberInDirectory()
    Dim folderPath As String
    Dim partNumber As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim foundCell As Range
    Dim searchRange As Range
    Dim fileDialog As FileDialog
    Dim found As Boolean
    Dim searchResult As String
    
    ' Set the flag for found parts to False initially
    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
    
    ' Get the first Excel file in the selected directory
    fileName = Dir(folderPath & "*.xls*") ' Search for .xls and .xlsx files
    
    ' If no Excel files are found, inform the user and exit
    If fileName = "" Then
        MsgBox "No Excel files found in the selected folder.", vbExclamation
        Exit Sub
    End If
    
    ' 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
                searchResult = "Part number " & partNumber & " found in file " & fileName & " on sheet " & ws.Name & " at cell " & foundCell.Address
                MsgBox searchResult, vbInformation
            End If
        Next ws
        
        ' Close the workbook without saving
        wb.Close SaveChanges:=False
        
        ' Move to the next file in the directory
        fileName = Dir
    Loop
    
    ' 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."
    End If
End Sub
Leave a Comment