Results 1 to 10 of 10

Running Macros in multiple Workbooks

This is a discussion on Running Macros in multiple Workbooks within the Excel Questions forums, part of the Question Forums category; Howdy, I would like to know all I can currently run macros in multiple workbooks I have in one directory. ...

  1. #1
    New Member
    Join Date
    Oct 2010
    Posts
    14

    Default Running Macros in multiple Workbooks

    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

  2. #2
    New Member
    Join Date
    Oct 2010
    Posts
    14

    Default Re: Running Macros in multiple Workbooks

    Any idea's?

  3. #3
    Board Regular drsarao's Avatar
    Join Date
    Sep 2009
    Location
    Delhi, India
    Posts
    1,107

    Default Re: Running Macros in multiple Workbooks

    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
    Excel 2007 Windows 7

  4. #4
    New Member
    Join Date
    Oct 2010
    Posts
    14

    Default Re: Running Macros in multiple Workbooks

    Thanks for that.

    Do I have to reference my Macro?

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

    Many thanks.

  5. #5
    Board Regular drsarao's Avatar
    Join Date
    Sep 2009
    Location
    Delhi, India
    Posts
    1,107

    Default Re: Running Macros in multiple Workbooks

    Where is your macro?
    Put my macro in the same module.
    Excel 2007 Windows 7

  6. #6
    Board Regular drsarao's Avatar
    Join Date
    Sep 2009
    Location
    Delhi, India
    Posts
    1,107

    Default Re: Running Macros in multiple Workbooks

    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.
    Excel 2007 Windows 7

  7. #7
    New Member
    Join Date
    Oct 2010
    Posts
    14

    Default Re: Running Macros in multiple Workbooks

    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

  8. #8
    Board Regular drsarao's Avatar
    Join Date
    Sep 2009
    Location
    Delhi, India
    Posts
    1,107

    Default Re: Running Macros in multiple Workbooks

    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?
    Excel 2007 Windows 7

  9. #9
    New Member
    Join Date
    Feb 2012
    Posts
    3

    Default Re: Running Macros in multiple Workbooks

    Quote Originally Posted by drsarao View Post
    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
    This works great! How can I get the macro to automatically save changes?

  10. #10
    Board Regular drsarao's Avatar
    Join Date
    Sep 2009
    Location
    Delhi, India
    Posts
    1,107

    Default Re: Running Macros in multiple Workbooks

    Blondie,
    Add the "Save" option. Thus:

    Workbooks(MyName).Close (True)
    Excel 2007 Windows 7

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com