Untitled
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