Untitled
unknown
plain_text
a year ago
2.9 kB
20
Indexable
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 SubEditor is loading...
Leave a Comment