Sub LoopAllExcelFilesInFolder()
Dim MyPath As String
Dim MyFile As String
Dim myExtension As String
Dim sh As Worksheet
Dim file As Workbook
Dim StrFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim sFV1 As String
Dim sTV1 As String
Dim sFV2 As String
Dim sTV2 As String
Dim sFV3 As String
Dim sTV3 As String
Dim sFV4 As String
Dim sTV4 As String
Dim sFV5 As String
Dim sTV5 As String
Dim sFV6 As String
Dim sTV6 As String
Dim sFV7 As String
Dim sTV7 As String
Dim sFV8 As String
Dim sTV8 As String
Dim sFV9 As String
Dim sTV9 As String
Dim sFV10 As String
Dim sTV10 As String
Dim sFV11 As String
Dim sTV11 As String
Dim sFV12 As String
Dim sTV12 As String
Dim sFV13 As String
Dim sTV13 As String
MyPath = Range("B1")
sFV1 = Range("B4")
sTV1 = Range("C4")
sFV2 = Range("B5")
sTV2 = Range("C5")
sFV3 = Range("B6")
sTV3 = Range("C6")
sFV4 = Range("B7")
sTV4 = Range("C7")
sFV5 = Range("B8")
sTV5 = Range("C8")
sFV6 = Range("B9")
sTV6 = Range("C9")
sFV7 = Range("B10")
sTV7 = Range("C10")
sFV8 = Range("B11")
sTV8 = Range("C11")
sFV9 = Range("B12")
sTV9 = Range("C12")
sFV10 = Range("B13")
sTV10 = Range("C13")
sFV11 = Range("B14")
sTV11 = Range("C14")
sFV12 = Range("B15")
sTV12 = Range("C15")
sFV13 = Range("B16")
sTV13 = Range("C16")
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' Parent folder
StrFolder = MyPath
' Loop through the subfolders
strSubFolder = Dir(StrFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
Debug.Print strSubFolder
Select Case strSubFolder
Case ".", ".."
' Current folder or parent folder - ignore
Case Else
' Add to collection
colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
End Select
' On to the next one
strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
Debug.Print varItem
' Loop through files in subfolder
strFile = Dir(StrFolder & varItem & "\" & "*.xlsx")
Do While strFile <> ""
Debug.Print strFile
Set file = Workbooks.Open(Filename:=StrFolder & varItem & "\" & strFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
For Each sh In ActiveWorkbook.Worksheets
sh.Cells.Replace What:=sFV1, Replacement:=sTV1, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV2, Replacement:=sTV2, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV3, Replacement:=sTV3, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV4, Replacement:=sTV4, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV5, Replacement:=sTV5, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV6, Replacement:=sTV6, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV7, Replacement:=sTV7, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV8, Replacement:=sTV8, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV9, Replacement:=sTV9, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV10, Replacement:=sTV10, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV11, Replacement:=sTV11, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV12, Replacement:=sTV12, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
sh.Cells.Replace What:=sFV13, Replacement:=sTV13, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Next sh
'Save and Close Workbook
ActiveWorkbook.Save
ActiveWorkbook.Close
'Ensure Workbook has closed before moving on to next line of code
DoEvents
strFile = Dir
Loop
Next varItem
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Bookmarks