VBA run macro in folder using multiple Subs and loop through all .xlsx files

[ceytl]

Hello,

I want to run a macro for all .xlsx files in Environ("UserProfile") & "\Desktop\orders\files\

I want it to open the workbook, run my VBA scripts, close the workbook, and loop through every .xlsx file in the folder.

I found a VBA script that can do this, but I have mutiple Subs, so I don't know how to make it work.

Here is the marco I found:

Sub OpenAllWorkbooks()
'Step 1:Declare your variables
    Dim MyFiles As String
'Step 2: Specify a target folder/directory, you may change it.
    MyFiles = Dir("c:\users\us\desktop\orders\temp\*.xlsx")
    Do While MyFiles <> ""
'Step 3: Open Workbooks one by one
    Workbooks.Open "c:\users\us\desktop\orders\temp\" & MyFiles

    'run some code here
   
    ActiveWorkbook.Close SaveChanges:=False

'Step 4: Next File in the folder/Directory
    MyFiles = Dir
    Loop

Here are the scripts I want to run on each .xlsx file in the folder, I know most of it could go into one Sub, but I pieced it together over time.

Any help would be appreciated!

Sub SplitOrder()
CopyCurrentSheetToTwoDifferentSheets
Split1Formula
Split2Formula
Paste_OnlyValues
Paste_OnlyValues2
PasteFormat
SumColumnF_1
SumColumnF_2
ChangeDate
SaveActiveSheet_as_Woorkbook1
SaveActiveSheet_as_Woorkbook2
End Sub
Private Sub CopyCurrentSheetToTwoDifferentSheets()
'
    Dim CopiesCounter   As Long
    Dim TotalCopies     As Long
    Dim xName           As String
    Dim ws              As Worksheet
'
    Application.ScreenUpdating = False
'
    Set ws = ActiveSheet                        ' <--- Set this to the sheet that you want to copy
'
    On Error Resume Next
'
    Application.DisplayAlerts = False
    Sheets("S1").Delete
    Sheets("S2").Delete
    Application.DisplayAlerts = True
'
    ws.Copy after:=Worksheets(Sheets.Count)
    ActiveSheet.Name = "S1"
'
    ActiveSheet.Cells.UnMerge
    Range("G1").EntireColumn.Insert

    ws.Copy after:=Worksheets(Sheets.Count)
    ActiveSheet.Name = "S2"
'
     ActiveSheet.Cells.UnMerge
     Range("G1").EntireColumn.Insert
     
    Application.ScreenUpdating = True
End Sub
Private Sub Split1Formula()

    Worksheets("Split 1").Range("G25").FormulaR1C1 = "=IF(R[-2]C[-3]>22,""Yes"",0)"
    
    Worksheets("Split 1").Range("G25:G834").FillDown
    
End Sub
Private Sub Split2Formula()

    Worksheets("S2").Range("G25").FormulaR1C1 = "=IF(R[-2]C[-3]>22,""Yes"",0)"
    
    Worksheets("S2").Range("G25:G834").FillDown
    
End Sub
Private Sub Paste_OnlyValues()

    Worksheets("S1").Range("G25:G834").Copy
    Worksheets("S1").Range("F25").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Worksheets("S1").Select
    Columns("G").Delete
   
End Sub
Private Sub Paste_OnlyValues2()

    Worksheets("S2").Range("G25:G834").Copy
    Worksheets("S2").Range("F25").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Worksheets("S2").Select
    Columns("G").Delete
   
End Sub
Private Sub PasteFormat()
    Worksheets(1).Select
    Cells.Select
    Selection.Copy
    Sheets("S1").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("S2").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub
Private Sub SumColumnF_1()
Dim Lr As Long, i As Long
Lr = Range("E" & Rows.Count).End(xlUp).row
For i = 25 To Lr
If Range("E" & i).HasFormula() = True Then Range("E" & i).AutoFill Destination:=Range("E" & i & ":F" & i)
Next i

End Sub
Private Sub SumColumnF_2()

Sheets("S1").Select
Dim Lr As Long, i As Long
Lr = Range("E" & Rows.Count).End(xlUp).row
For i = 25 To Lr
If Range("E" & i).HasFormula() = True Then Range("E" & i).AutoFill Destination:=Range("E" & i & ":F" & i)
Next i

End Sub
Private Sub ChangeDate()
    Sheets("S2").Select
    Range("H7").Select
    ActiveCell.FormulaR1C1 = "11/1/2021"
End Sub
Private Sub SaveActiveSheet_as_Woorkbook1()

Dim wb As Workbook

    Worksheets("S1").Copy
    Set wb = ActiveWorkbook
    wb.SaveAs Environ("UserProfile") & "\Desktop\orders\S1\" & "1 Order " & Range("B5").Value, FileFormat:=xlOpenXMLWorkbook
    wb.Close

End Sub
Private Sub SaveActiveSheet_as_Woorkbook2()

Dim wb As Workbook

    Worksheets("S2").Copy
    Set wb = ActiveWorkbook
    wb.SaveAs Environ("UserProfile") & "\Desktop\orders\S2\" & "2Order " & Range("B5").Value, FileFormat:=xlOpenXMLWorkbook
    wb.Close

End Sub

 

[jolivanes]

I don't have an answer for you but instead of possible helpers having to go through somewhere around 100 lines of code that does not work, it might be better to explain in a concise manner what you want to do with each workbook opened.

 

[ceytl]

I don't have an answer for you but instead of possible helpers having to go through somewhere around 100 lines of code that does not work, it might be better to explain in a concise manner what you want to do with each workbook opened.

@jolivanes thanks for your response!

The code does work.

I am looking for a way to open a closed workbook and run my 11 Subs, then close the workbook and do the same thing to every .xlsx file in the folder.

Is this possible, and how would I do it?

 

[dmt32]

The code does work.

I am looking for a way to open a closed workbook and run my 11 Subs, then close the workbook and do the same thing to every .xlsx file in the folder.

Is this possible, and how would I do it?

Hi,
try this update to code code you posted & see if it will help you

Sub OpenAllWorkbooks(Optional ByVal FolderPath As Variant)
    'Step 1:Declare your variables
    Dim MyFiles     As String
    Dim wb          As Workbook
  
    Const DefaultFolderPath As String = "c:\users\us\desktop\orders\temp\"
  
    'check for folder path & if missing, use default
    If IsMissing(FolderPath) Then FolderPath = DefaultFolderPath
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
  
    On Error Goto exitsub

    'Step 2: the target folder/directory.
    MyFiles = Dir(FolderPath & "*.xlsx")
    Application.ScreenUpdating = False
    Do While MyFiles <> ""
        'Step 3: Open Workbooks one by one
        Set wb = Workbooks.Open(FolderPath & MyFiles, False, True)
      
        'run your code here
        SplitOrder
      
        wb.Close False
      
        'Step 4: Next File in the folder/Directory
        MyFiles = Dir
        'clear object variable
        Set wb = Nothing
    Loop
  
exitsub:
    'report errors
    If Not wb Is Nothing Then wb.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

I have added Optional Parameter FolderPath to the code to allow you to specify alternative Folder Path without need to update this in the coding.
There is a Default Folder Path (shown in bold) you can specify - change this as required.

I have not looked at all your codes but assume that you are just opening & copying data from the workbooks & then closing without saving them?
and have set all opened workbooks to ReadOnly & SaveChanges to False. If this is not case, these parameters will need to be changed.

Dave

 

[jolivanes]

My initial request still stands. Explain in detail.
But for now you can make up another macro as follows:

Sub Run_All()
first_macro    '<---- change to name of first macro to run
second_macro    '<---- change to name of second macro to run
third_macro     '<---- change to name of third macro to run
.....
.....
last_macro
End Sub
[code]

 

[ceytl]

Hi,
try this update to code code you posted & see if it will help you

Sub OpenAllWorkbooks(Optional ByVal FolderPath As Variant)
    'Step 1:Declare your variables
    Dim MyFiles     As String
    Dim wb          As Workbook
 
    Const DefaultFolderPath As String = "c:\users\us\desktop\orders\temp\"
 
    'check for folder path & if missing, use default
    If IsMissing(FolderPath) Then FolderPath = DefaultFolderPath
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
 
    On Error Goto exitsub

    'Step 2: the target folder/directory.
    MyFiles = Dir(FolderPath & "*.xlsx")
    Application.ScreenUpdating = False
    Do While MyFiles <> ""
        'Step 3: Open Workbooks one by one
        Set wb = Workbooks.Open(FolderPath & MyFiles, False, True)
     
        'run your code here
        SplitOrder
     
        wb.Close False
     
        'Step 4: Next File in the folder/Directory
        MyFiles = Dir
        'clear object variable
        Set wb = Nothing
    Loop
 
exitsub:
    'report errors
    If Not wb Is Nothing Then wb.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

I have added Optional Parameter FolderPath to the code to allow you to specify alternative Folder Path without need to update this in the coding.
There is a Default Folder Path (shown in bold) you can specify - change this as required.

I have not looked at all your codes but assume that you are just opening & copying data from the workbooks & then closing without saving them?
and have set all opened workbooks to ReadOnly & SaveChanges to False. If this is not case, these parameters will need to be changed.

Dave

Thanks for your help!