Analyst Cave

VBA Run Macro on All Files in a Folder / All Worksheets in a Workbook

A very popular Excel automation scenario is the need to a VBA run macro on all files in a folder or running VBA on all Worksheets in an Excel Workbook. This is a very typical case where you process similar data dump files and want to extract data or transform the workbook. In this post I will provide ready code snippets to address these scenarios and walk you through what happens.

VBA Run Macro on All Files in a Folder

To run macro on all files in folder use the code snippet below. The code will do the following:

To make it more simple currWb and currWS represent the ActiveWorkbook and ActiveWorksheet whereas wb represents the newly opened Workbook from the selected folder.

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If
    
    
    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    fileName = Dir(folderName & "\*.*")
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName


        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
        '...
        'YOUR CODE HERE
        '...
        wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & folderName & "\" & fileName 
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

There is also built in simple progress tracking via the Application StatusBar.

VBA Run Macro on All Files in Subfolders

A scenario of the above case when you want to run a macro on all Excel files in a folder is also traversing all subfolders to run your macro. The below is an extension of the above and utilizes a slightly modified version of the TraversePath procedure from here.

The below is almost identical to the above, however, notice the global variable fileCollection. This will be used to first store all file identified in subfolders and only after used to run all macros on files stored in this VBA Collection.

Dim fileCollection As Collection
Sub TraversePath(path As String)
    Dim currentPath As String, directory As Variant
    Dim dirCollection As Collection
    Set dirCollection = New Collection
    
    currentPath = Dir(path, vbDirectory)
    
    'Explore current directory
    Do Until currentPath = vbNullString
        Debug.Print currentPath
        If Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
            dirCollection.Add currentPath
        ElseIf Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbNormal) = vbNormal Then
            fileCollection.Add path & currentPath
        End If
        currentPath = Dir()
    Loop
    
    'Explore subsequent directories
    For Each directory In dirCollection
        Debug.Print "---SubDirectory: " & directory & "---"
        TraversePath path & directory & "\"
    Next directory
End Sub

Sub RunOnAllFilesInSubFolders()
    Dim folderName As String, eApp As Excel.Application, fileName As Variant
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If
    
    
    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    Set fileCollection = New Collection
    TraversePath folderName & "\"

    For Each fileName In fileCollection
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & fileName


        Set wb = eApp.Workbooks.Open(fileName)
        '...
        'YOUR CODE HERE.
        '...
        wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & fileName  'Print progress on Immediate window
    Next fileName
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

Run VBA on All Worksheets

To run macro on all Sheets in Workbook you need to can use the code snippet below. Here is a walkthrough of the code:

Sub RunOnAllWorksheets()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    
    For Each ws In Sheets
        If ws.Name <> currWs.Name Then
            'Update status bar to indicate progress
            Application.StatusBar = "Processing " & ws.Name
            '...
            'YOUR CODE HERE
            '...
            Debug.Print "Processed " & ws.Name
        End If
    Next ws
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all worksheets"
End Sub
Exit mobile version