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

ceytl

Board Regular
Joined
Jun 6, 2009
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
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:

Rich (BB code):
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!

Rich (BB code):
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,932
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
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

Board Regular
Joined
Jun 6, 2009
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Jul 3, 2012
Messages
7,357
Office Version
  1. 2019
Platform
  1. Windows
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


Rich (BB code):
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
 
Solution

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,932
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
My initial request still stands. Explain in detail.
But for now you can make up another macro as follows:
Code:
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

Board Regular
Joined
Jun 6, 2009
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
Hi,
try this update to code code you posted & see if it will help you


Rich (BB code):
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!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,678
Messages
5,838,734
Members
430,566
Latest member
ChanchalSingh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top