Macro to Loop and Run Based on File Name

[exceljunk]

I have a main folder on my desktop, lets call it 'C:\Users\Desktop\Update'. Within that folder I have 3 additional folder lets call them 'FY21', 'FY22' and 'FY23'. Within each of those subfolders there are 5 XLSX files. I have created a code for each file based on the subfolder they are in. I am trying to run a single macro that will go through the subfolders and run the codes I've created based on the subfolder and file names.

The files within each subfolder have a consistent partial filename followed by unique numbers that are different each week.


Main folder location > 'C:\Users\Desktop\Update'
Sub folder names > 'FY21', 'FY22' and 'FY23'
Partial Names within EACH subfolder > Apple_1234567890, Oranges_9875342716, Berries_4937405736, Lemons_9283741092, Pears_9362537120

FY21 Apple Macro ran only on file name 'Apple' within FY21 sub folder
FY22 Apple Macro ran only on file name 'Apple' within FY22 sub folder
FY23 Apple Macro ran only on file name 'Apple' within FY23 sub folder

FY21 Oranges Macro ran only on file name 'Oranges' within FY21 sub folder
FY22 Oranges Macro ran only on file name 'Oranges' within FY22 sub folder
FY23 Oranges Macro ran only on file name 'Oranges' within FY23 sub folder

etc.

Below are two (Apple and Orange) of the 5 codes that I would run within the FY21 subfolder. The only difference in codes between FY is the files that are added and the location that it is saved.

Sub FY21_Apple_SG()

'

' SelfGenApple Macro

'



'

Rows("1:6").Select

Range("A6").Activate

Application.CutCopyMode = False

Selection.Delete Shift:=xlUp

Selection.Insert Shift:=xlDown

Range("A1").Select

ActiveCell.FormulaR1C1 = "Apples FY21"

Range("A2").Select

ActiveCell.FormulaR1C1 = "Apples"

Range("A4").Select

ActiveCell.FormulaR1C1 = "User: Name"

Range("A5").Select

ActiveCell.FormulaR1C1 = "Report Date: 09/13/2022"

Range("A1").Select

With Selection.Font

.Name = "Calibri"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

Selection.Font.Bold = True

Rows("7:7").Select

Selection.Style = "Normal"

Selection.Font.Bold = True

ActiveWindow.FreezePanes = False

Columns("N:N").Select

Selection.NumberFormat = "@"

Columns("W:W").Select

Selection.Delete Shift:=xlToLeft

Sheets("Parameters").Select

Application.DisplayAlerts = False

ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True



Dim wbk1 As Workbook, wbk2 As Workbook



'add your own file path

fileStr = "\\C:\Users\Desktop\Update\FY21 Good Parameters Tab.xlsx"



Set wbk1 = ActiveWorkbook

Set wbk2 = Workbooks.Add(fileStr)



'wbk2.Sheets("Bridge 1").Copy After:=Workbooks("WorkbookNameYouCopyCodeInto").Sheets(1)

wbk2.Sheets("Parameters").Copy After:=wbk1.Sheets(1)

wbk2.Saved = True





Dim newName As String

newName = “\\C:\Users\Desktop\Update Complete\FY21\” & Replace(ActiveWorkbook.Name, "Apple", "Apple")

ActiveWorkbook.SaveAs Filename:=newName

ActiveWorkbook.Close



Windows("FY21 Good Parameters Tab1").Activate

ActiveWindow.Close

End Sub







Sub FY21_Oranges_SG()

'

' SelfGenOranges Macro

'



'

Rows("1:6").Select

Range("A6").Activate

Selection.Delete Shift:=xlUp

Selection.Insert Shift:=xlDown

Rows("7:7").Select

Selection.Style = "Normal"

Selection.Font.Bold = True

ActiveWindow.FreezePanes = False

ActiveWindow.SmallScroll ToRight:=16

Range("Q7").Select

ActiveCell.FormulaR1C1 = "OrangeNum"

Columns("O:O").Select

Selection.NumberFormat = "@"

Columns("W:W").Select

Selection.Delete Shift:=xlToLeft

Sheets("Parameters").Select

Application.DisplayAlerts = False

ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True

Dim wbk1 As Workbook, wbk2 As Workbook



'add your own file path

fileStr = "\\C:\Users\Desktop\Update\FY21 Good Parameters Tab.xlsx"

Set wbk1 = ActiveWorkbook

Set wbk2 = Workbooks.Add(fileStr)



'wbk2.Sheets("Bridge 1").Copy After:=Workbooks("WorkbookNameYouCopyCodeInto").Sheets(1)

wbk2.Sheets("Parameters").Copy After:=wbk1.Sheets(1)

wbk2.Saved = True



newName = “\\C:\Users\Desktop\Update Complete\FY21\” & Replace(ActiveWorkbook.Name, "Orange", "Orange")



Dim newName As String

newName = “\\C:\Users\Desktop\Update Complete\FY21\” & Replace(ActiveWorkbook.Name, "Orange", "Orange")

ActiveWorkbook.SaveAs Filename:=newName

ActiveWorkbook.Close



Windows("FY21 Good Parameters Tab1").Activate

ActiveWindow.Close



End Sub