Running Macros in multiple Workbooks

0

0Das0

New Member
Joined
Oct 28, 2010
Messages
14
Howdy,

I would like to know all I can currently run macros in multiple workbooks I have in one directory. At the moment I am opening up around 75 different workbooks and running them individually. I have provided the code below which is the macro I use.

The directory is P:\PETERB\ASSETS\Capex\Cap 2012\Monthly Reports for PM's\"Period month year"

Many thanks in Advance.

Code: 
Sub UpdatePMReport()
'
' CopyDataIntoSheetPO Macro
' Macro recorded 24/03/2011 by Mark Proctor
'

    Application.ScreenUpdating = False


    
    'Define Variables
    Dim CapExNo As Range
        Set CapExNo = Sheets("Summary").Range("B5")
        
    Dim ReportWorkbookName As Workbook
        Set ReportWorkbookName = ActiveWorkbook
        

        
    'Create new spreadsheet
    Sheets.Add.Name = "DataSheet"
    
    'Copy data to new sheet.
    Windows("PM Reports MacroBook").Activate
    Sheets("PO Info").Select
    Cells.Select
    Selection.Copy
    ReportWorkbookName.Activate
    Sheets("DataSheet").Cells.Select
    ActiveSheet.Paste
        
    'Delete Deleted Items
    Cells.Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="@11@"
    Rows("2:10000").Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=2

    'Select the CapEx number
    Selection.AutoFilter Field:=10, Criteria1:=CapExNo

    'Count the number of rows
    Dim rng As Range
    Set rng = ActiveSheet.AutoFilter.Range


    'If no lines to add then don't add anything
    If rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then

    'Clear Contents of Analysis Sheet
    Sheets("Analysis").Select
    Range("A4").Select
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim FirstEmptyRow As Long
        FirstEmptyRow = ActiveCell.Row
    
    Sheets("Analysis").Select
    Range("A5:K" & FirstEmptyRow - 1).ClearContents
     

    'Insert rows into Analysis Sheet
    Dim RowStart As Long
        RowStart = "6"
    Dim RowEnd As Long
        RowEnd = RowStart + rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    Dim RowFull As Long
        RowFull = rng.Rows.Count - 1
    
    Sheets("Analysis").Select
    Rows(RowStart & ":" & RowEnd).Select
    Selection.Insert Shift:=xlDown

    Sheets("DataSheet").Select
    Range("A2:A" & RowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("A" & RowStart - 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("DataSheet").Select
    Range("C2:E" & RowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("B" & RowStart - 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
                
        
    Sheets("DataSheet").Select
    Range("L2:R" & RowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("F" & RowStart - 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'Delete Blank Rows
    
    Sheets("Analysis").Select
    Range("D" & RowEnd).Select
    ActiveCell.Offset(1, 0).Select
    Do While IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim LastEmptyRow As Long
        LastEmptyRow = ActiveCell.Row
    
    Rows(RowEnd - 1 & ":" & LastEmptyRow - 1).Delete
        
    Else
        MsgBox ("No PO's Found")
        Dim NoPOs As Long
            NoPOs = 1
    End If
    
    
    'Delete Data Sheet
    Application.DisplayAlerts = False
    Sheets("DataSheet").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    
    'Show where Foreignt Currenices have been used
    
    Sheets("Analysis").Select
    Range("L5").Select

    Do
        If ActiveCell.Value = "GBP" Then
            ActiveCell.Value = ""
        Else
            ActiveCell.Interior.ColorIndex = 3
        End If
    
        ActiveCell.Offset(1, 0).Select
    Loop Until IsEmpty(ActiveCell)


'INSERT JOURNALS


    'Create new spreadsheet
    Sheets.Add.Name = "DataSheet"
    
    
    'Copy Data Into New Worksheet
    Windows("PM Reports MacroBook").Activate
    Sheets("Direct Info").Select
    Cells.Select
    Selection.Sort Key1:=Range("R2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Selection.Copy
    ReportWorkbookName.Activate
    Sheets("DataSheet").Cells.Select
    ActiveSheet.Paste
    
    'Delete Journals that should not display Items
    Cells.Select
    Selection.AutoFilter Field:=8, Criteria1:="PFRMP11029"
    Rows("2:10000").Select
    Selection.Delete Shift:=xlUp
    Cells.Select
    Selection.AutoFilter

    
    'Select the CapEx number
    Cells.Select
    Selection.AutoFilter Field:=11, Criteria1:=CapExNo

    'Count the number of rows
    Set rng = ActiveSheet.AutoFilter.Range
    
    If rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
    
    
    
    'Clear Contents of Analysis Sheet
    Sheets("Analysis").Select
    Range("A4").Select
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim JournalFirstRow As Long
        JournalFirstRow = ActiveCell.Row + 2

    Range("A" & JournalFirstRow).Select
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim JournalLastRow As Long
        JournalLastRow = ActiveCell.Row

    Range("A" & JournalFirstRow & ":K" & JournalLastRow - 1).ClearContents

    'Insert rows into Analysis Sheet
    
    Dim RowsOfJournals As Long
        RowsOfJournals = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    
    Dim RowsOfJournalsInsert As Long
        RowsOfJournalsInsert = RowsOfJournals - JournalLastRow + JournalFirstRow

    
    Sheets("Analysis").Select
    If RowsOfJournalsInsert > 0 Then
        Rows(JournalFirstRow + 1 & ":" & JournalFirstRow + 1 + RowsOfJournalsInsert - 1).Select
        Selection.Insert Shift:=xlDown
    End If

    Dim JournalRowFull As Long
        JournalRowFull = rng.Rows.Count - 1
    
    If NoPOs = 1 Then
        JournalFirstRow = JournalFirstRow + 1
    End If
        
    
    
     Sheets("DataSheet").Select
    Range("H2:H" & JournalRowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("A" & JournalFirstRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
     Sheets("DataSheet").Select
    Range("I2:I" & JournalRowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("D" & JournalFirstRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
     Sheets("DataSheet").Select
    Range("T2:T" & JournalRowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("J" & JournalFirstRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Else
        MsgBox ("No Journals Found")
    End If
    
    
    'Delete Data Sheet
    Application.DisplayAlerts = False
    Sheets("DataSheet").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    

    
End Sub
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
The following batch script will:
Open the file from the given directory.
Run your code.
Close the File.
Loop to next file and do above actions till all files are finished.


Code: 
Sub BatchProcessing()
MyPath = "P:\PETERB\ASSETS\Capex\Cap 2012\Monthly Reports for PM's\Period month year\"
MyTemplate = "*.xls*"  ' Set the template.
MyName = Dir(MyPath & MyTemplate)    'Retrieve the first file
Do While MyName <> ""
    Workbooks.Open MyPath & MyName
    UpdatePMReport                 'do your thing
    Workbooks(MyName).Close         'close
    MyName = Dir                    'Get next file
Loop
End Sub
 
Upvote 0
Thanks for that.

Do I have to reference my Macro?

As I am getting the error message "sub or function not defined"

Many thanks.
 
Upvote 0
Where is your macro?
Put my macro in the same module.
 
Upvote 0
Incidentally both the macros should be in an open workbook separate from all those files in the given directory.
Maybe put them in the common PERSONAL.XLS file.
 
Upvote 0
Thanks again for the help.

I have the Macro below in a workbook called personal.xls

The Workbook I need open and the macro running in is 16129 311011.xls
(the macro in this workbook pull information from another workbook called "PM report Macro workbook.)

Can you see any problems?

Code: 
Sub BatchProcessing()
MyPath = "P:\PETERB\ASSETS\Capex\Cap 2012\Monthly Reports for PM's\Period month year\"
MyTemplate = "16129 311011.xls"  ' Set the template.
MyName = Dir(MyPath & MyTemplate)    'Retrieve the first file
Do While MyName <> ""
    Workbooks.Open MyPath & MyName
    UpdatePMReport                 'do your thing
    Workbooks(MyName).Close         'close
    MyName = Dir                    'Get next file
Loop
End Sub


Sub UpdatePMReport()
'
' CopyDataIntoSheetPO Macro
' Macro recorded 24/03/2011 by Mark Proctor
'

    Application.ScreenUpdating = False


    
    'Define Variables
    Dim CapExNo As Range
        Set CapExNo = Sheets("Summary").Range("B5")
        
    Dim ReportWorkbookName As Workbook
        Set ReportWorkbookName = ActiveWorkbook
        

        
    'Create new spreadsheet
    Sheets.Add.Name = "DataSheet"
    
    'Copy data to new sheet.
    Windows("PM Reports MacroBook").Activate
    Sheets("PO Info").Select
    Cells.Select
    Selection.Copy
    ReportWorkbookName.Activate
    Sheets("DataSheet").Cells.Select
    ActiveSheet.Paste
        
    'Delete Deleted Items
    Cells.Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="@11@"
    Rows("2:10000").Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=2

    'Select the CapEx number
    Selection.AutoFilter Field:=10, Criteria1:=CapExNo

    'Count the number of rows
    Dim rng As Range
    Set rng = ActiveSheet.AutoFilter.Range


    'If no lines to add then don't add anything
    If rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then

    'Clear Contents of Analysis Sheet
    Sheets("Analysis").Select
    Range("A4").Select
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim FirstEmptyRow As Long
        FirstEmptyRow = ActiveCell.Row
    
    Sheets("Analysis").Select
    Range("A5:K" & FirstEmptyRow - 1).ClearContents
     

    'Insert rows into Analysis Sheet
    Dim RowStart As Long
        RowStart = "6"
    Dim RowEnd As Long
        RowEnd = RowStart + rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    Dim RowFull As Long
        RowFull = rng.Rows.Count - 1
    
    Sheets("Analysis").Select
    Rows(RowStart & ":" & RowEnd).Select
    Selection.Insert Shift:=xlDown

    Sheets("DataSheet").Select
    Range("A2:A" & RowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("A" & RowStart - 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("DataSheet").Select
    Range("C2:E" & RowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("B" & RowStart - 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
                
        
    Sheets("DataSheet").Select
    Range("L2:R" & RowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("F" & RowStart - 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'Delete Blank Rows
    
    Sheets("Analysis").Select
    Range("D" & RowEnd).Select
    ActiveCell.Offset(1, 0).Select
    Do While IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim LastEmptyRow As Long
        LastEmptyRow = ActiveCell.Row
    
    Rows(RowEnd - 1 & ":" & LastEmptyRow - 1).Delete
        
    Else
        MsgBox ("No PO's Found")
        Dim NoPOs As Long
            NoPOs = 1
    End If
    
    
    'Delete Data Sheet
    Application.DisplayAlerts = False
    Sheets("DataSheet").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    
    'Show where Foreignt Currenices have been used
    
    Sheets("Analysis").Select
    Range("L5").Select

    Do
        If ActiveCell.Value = "GBP" Then
            ActiveCell.Value = ""
        Else
            ActiveCell.Interior.ColorIndex = 3
        End If
    
        ActiveCell.Offset(1, 0).Select
    Loop Until IsEmpty(ActiveCell)


'INSERT JOURNALS


    'Create new spreadsheet
    Sheets.Add.Name = "DataSheet"
    
    
    'Copy Data Into New Worksheet
    Windows("PM Reports MacroBook").Activate
    Sheets("Direct Info").Select
    Cells.Select
    Selection.Sort Key1:=Range("R2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Selection.Copy
    ReportWorkbookName.Activate
    Sheets("DataSheet").Cells.Select
    ActiveSheet.Paste
    
    'Delete Journals that should not display Items
    Cells.Select
    Selection.AutoFilter Field:=8, Criteria1:="PFRMP11029"
    Rows("2:10000").Select
    Selection.Delete Shift:=xlUp
    Cells.Select
    Selection.AutoFilter

    
    'Select the CapEx number
    Cells.Select
    Selection.AutoFilter Field:=11, Criteria1:=CapExNo

    'Count the number of rows
    Set rng = ActiveSheet.AutoFilter.Range
    
    If rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
    
    
    
    'Clear Contents of Analysis Sheet
    Sheets("Analysis").Select
    Range("A4").Select
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim JournalFirstRow As Long
        JournalFirstRow = ActiveCell.Row + 2

    Range("A" & JournalFirstRow).Select
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim JournalLastRow As Long
        JournalLastRow = ActiveCell.Row

    Range("A" & JournalFirstRow & ":K" & JournalLastRow - 1).ClearContents

    'Insert rows into Analysis Sheet
    
    Dim RowsOfJournals As Long
        RowsOfJournals = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    
    Dim RowsOfJournalsInsert As Long
        RowsOfJournalsInsert = RowsOfJournals - JournalLastRow + JournalFirstRow

    
    Sheets("Analysis").Select
    If RowsOfJournalsInsert > 0 Then
        Rows(JournalFirstRow + 1 & ":" & JournalFirstRow + 1 + RowsOfJournalsInsert - 1).Select
        Selection.Insert Shift:=xlDown
    End If

    Dim JournalRowFull As Long
        JournalRowFull = rng.Rows.Count - 1
    
    If NoPOs = 1 Then
        JournalFirstRow = JournalFirstRow + 1
    End If
        
    
    
     Sheets("DataSheet").Select
    Range("H2:H" & JournalRowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("A" & JournalFirstRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
     Sheets("DataSheet").Select
    Range("I2:I" & JournalRowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("D" & JournalFirstRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
     Sheets("DataSheet").Select
    Range("T2:T" & JournalRowFull).Select
    Selection.Copy

    Sheets("Analysis").Select
    Range("J" & JournalFirstRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Else
        MsgBox ("No Journals Found")
    End If
    
    
    'Delete Data Sheet
    Application.DisplayAlerts = False
    Sheets("DataSheet").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    

    
End Sub
 
Upvote 0
Your code is very long to check. Is it working if you use it manually?

In my code the template should be changed back: --> MyTemplate = "*.xls" (This is basically required by DIR() to keep pulling files with the Template extension.)

I checked my code with a dummy Sub UpdatePMReport(). It seems to work fine.

What are the errors/problems?
 
Upvote 0
drsarao said:
The following batch script will:
Open the file from the given directory.
Run your code.
Close the File.
Loop to next file and do above actions till all files are finished.


Code: 
Sub BatchProcessing()
MyPath = "P:\PETERB\ASSETS\Capex\Cap 2012\Monthly Reports for PM's\Period month year\"
MyTemplate = "*.xls*"  ' Set the template.
MyName = Dir(MyPath & MyTemplate)    'Retrieve the first file
Do While MyName <> ""
    Workbooks.Open MyPath & MyName
    UpdatePMReport                 'do your thing
    Workbooks(MyName).Close         'close
    MyName = Dir                    'Get next file
Loop
End Sub
Click to expand...

This works great! How can I get the macro to automatically save changes?
 
Upvote 0
Blondie,
Add the "Save" option. Thus:

Workbooks(MyName).Close (True)
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
196
Coco1
C
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
164
DanteAmor
DanteAmor
G
  • Solved
Add total row with a loop
Replies
4
Views
120
gberg
G
P
  • Solved
Counter in For Each loop
Replies
2
Views
182
Possum17
P
C
  • Question
Calculations require application restart
Replies
2
Views
142
cpupartsplz
C

Forum statistics

Threads
1,214,553
Messages
6,120,184
Members
448,949
Latest member
keycalinc

Share this page

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
Back
Top