Hello XL Gurus,
I have a list of IDs in a file and I need a macro to loop through the xls* files in a directory (which has ~100 folders, each folder has ~10 sub folders). Literally there are 1000s of files and each ID is in a folder. To make it faster, I could have the IDs and the Folder Name in a table. I found the following macro here in the forums but need to tweak a little to search sub folders. Can someone help me with this?
Thanks in advance for any help.
I have a list of IDs in a file and I need a macro to loop through the xls* files in a directory (which has ~100 folders, each folder has ~10 sub folders). Literally there are 1000s of files and each ID is in a folder. To make it faster, I could have the IDs and the Folder Name in a table. I found the following macro here in the forums but need to tweak a little to search sub folders. Can someone help me with this?
Thanks in advance for any help.
Code:
Sub LoopThroughFiles()
Dim file As Variant
Dim sht As Worksheet, path As String, y As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
i = 2
path = ThisWorkbook.Sheets("sheet1").Range("a2").Value
If Right(path, 1) <> "\" Then path = path & "\"
file = Dir(path & "*.xls*")
While (file <> "")
Workbooks.Open path & file
For Each cell In ThisWorkbook.Sheets("sheet1").Range("list")
For Each sht In ActiveWorkbook.Sheets
Set y = sht.Cells.Find(What:=cell.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If y Is Nothing Then
GoTo Skip:
Else
ThisWorkbook.Sheets("sheet2").Range("a" & i).Value = cell.Value
ThisWorkbook.Sheets("sheet2").Range("b" & i).Value = y.Address
ThisWorkbook.Sheets("sheet2").Range("c" & i).Value = sht.Name
ThisWorkbook.Sheets("sheet2").Range("d" & i).Value = file
ThisWorkbook.Sheets("sheet2").Range("e" & i).Value = path
i = i + 1
End If
found = y.Address
Skip:
Next sht
Next cell
ActiveWorkbook.Close
file = Dir()
Wend
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub