Progress in Status Bar For Macro That Loops Through All Excel Files in a Folder

Daniel_G

New Member
Joined
Apr 2, 2016
Messages
5
<dl class="userinfo_extra" style="margin: 5px 0px; float: left; width: 180px; height: auto !important;"><dt style="margin: 0px 10px 0px 0px; padding: 0px; float: left; min-width: 60px; width: auto !important;">Join Date</dt><dd style="margin: 0px; padding: 0px 0px 3px;">Apr 2016</dd><dt style="margin: 0px 10px 0px 0px; padding: 0px; float: left; min-width: 60px; width: auto !important;">Posts</dt><dd style="margin: 0px; padding: 0px 0px 3px;">1</dd></dl>

icon1.png
Progress in Status Bar For Macro That Loops Through All Excel Files in a Folder


<ins class="adsbygoogle" data-ad-client="ca-pub-2974935598394359" data-ad-slot="8003857391" data-adsbygoogle-status="done" style="text-decoration: none; display: inline-block; width: 300px; height: 250px;"><ins id="aswift_0_expand" style="text-decoration: none; display: inline-table; border: none; height: 250px; margin: 0px; padding: 0px; position: relative; visibility: visible; width: 300px; background-color: transparent;"><ins id="aswift_0_anchor" style="text-decoration: none; display: block; border: none; height: 250px; margin: 0px; padding: 0px; position: relative; visibility: visible; width: 300px; background-color: transparent;">******** width="300" height="250" frameborder="0" marginwidth="0" marginheight="0" vspace="0" hspace="0" allowtransparency="true" scrolling="no" allowfullscreen="true" id="aswift_0" name="aswift_0" style="left: 0px; position: absolute; top: 0px;">*********></ins></ins></ins>
Dear Board,

I have written a code (below) that loops through all Excel files ("wbT") in a folder and performs a few tasks (using a "Main Code").

The "Main Code" is performed on each file in the folder one at a time. In other words, a file is opened, tasks are performed, the file is saved/closed, then the next file is opened and so on, until there are no more files in the folder.

The files in the folder can change quantity depending on if a new file is manually added or an old file is manually removed.

Because the quantity of files is not fixed, a "count" has been added. Its value can be found in "A5" of "Sheet1" of the main workbook ("wbM" houses the code).

I want to know the progress of this macro in the Status Bar. For example, "Processed x of y files. z % complete."

I figure if there are 5 files ("y") in the folder, for example, then every iteration through the "Main Loop" could be 1/5 or 20% (z) progress. If 4 files are complete, then the Status Bar could read, "Processed 4 of 5 files. 80% complete."

I've researched the internet for similar cases, but cannot figure this out.

I believe the solution is related to a "For/Next" loop, but I'm not sure how to write it or where it is to be located within (or around) the "Main Loop."

Any help or guidance is much appreciated!


Sub STATUSBARPROGRESS_LOOPINDEFINITEFILESINFOLDER()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = True


'Setup Variables
Dim folderPathP As String
Dim filenameP As String
Dim wbT As Workbook
Dim wbM As ThisWorkbook
Set wbM = Workbooks("MacroStatusBarProgress.xlsm")

'Define Folder
folderPathP = "C:\Users\Daniel\Desktop\Templates\" 'change to suit
If Right(folderPathP, 1) <> "\" Then folderPathP = folderPathP + "\"

'Define Filename
filenameP = Dir(folderPathP & "*.xlsm")

'Count Files for StatusBar Progress
Do While filenameP <> ""
Dim Count As Integer
Count = Count + 1
filenameP = Dir()
Loop
wbM.Sheets("sheet1").Range("A5").Value = Count

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Create Loop for multiple Files
Do While filenameP <> ""

'Open Each File in Folder
Set wbT = Workbooks.Open(folderPathP & filenameP)

'MAIN CODE GOES HERE


'Close File
wbT.Close True


'Complete/End Loop
filenameP = Dir

Loop

End Sub


 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Code:
[color=darkblue]Sub[/color] STATUSBARPROGRESS_LOOPINDEFINITEFILESINFOLDER()
    Application.ScreenUpdating = [color=darkblue]True[/color]
    Application.DisplayAlerts = [color=darkblue]True[/color]
    Application.DisplayStatusBar = [color=darkblue]True[/color]
        
    [color=green]'Setup Variables[/color]
    [color=darkblue]Dim[/color] folderPathP [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] filenameP   [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] wbT         [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] TotFiles    [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] FileCounter [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=green]'[/color]
    [color=green]'Define Folder[/color]
    folderPathP = "C:\Users\Daniel\Desktop\Templates\"    [color=green]'change to suit[/color]
    
    [color=darkblue]If[/color] Right(folderPathP, 1) <> "\" [color=darkblue]Then[/color] folderPathP = folderPathP + "\"
    
    [color=green]'Define Filename[/color]
    filenameP = Dir(folderPathP & "*.xlsm")
    
    [color=green]'Count Files for StatusBar Progress[/color]
    [color=darkblue]Do[/color] [color=darkblue]While[/color] filenameP <> ""
        [color=darkblue]Dim[/color] Count [color=darkblue]As[/color] [color=darkblue]Integer[/color]
        TotFiles = TotFiles + 1
        filenameP = Dir()
    [color=darkblue]Loop[/color]
    ThisWorkbook.Sheets("sheet1").Range("A5").Value = TotFiles
    
    [color=green]'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/color]
    
    [color=green]'Create Loop for multiple Files[/color]
    filenameP = Dir(folderPathP & "*.xlsm")
    [color=darkblue]Do[/color] [color=darkblue]While[/color] filenameP <> ""
    
        FileCounter = FileCounter + 1
        Application.StatusBar = "Processed " & FileCounter & " of " & TotFiles & " files. " & Format(FileCounter / TotFiles, "0%") & " complete."
    
        [color=green]'Open Each File in Folder[/color]
        [color=darkblue]Set[/color] wbT = Workbooks.Open(folderPathP & filenameP)
    
        [color=green]'MAIN CODE GOES HERE[/color]
    
    
        [color=green]'Close File[/color]
        wbT.Close [color=darkblue]True[/color]
    
    
        [color=green]'Complete/End Loop[/color]
        filenameP = Dir
    
    [color=darkblue]Loop[/color]
    
    Application.StatusBar = "All files processed."
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
Welcome to the MrExcel board!

For future posts, please use the standard forum font. Ref #14 of the Forum Rules.
 
Upvote 0
Dear Alpha Frog,

Thank you for the rapid response.

The code "breaks" on:
Application.StatusBar = "Processed " & FileCounter & " of " & TotFiles & " files. " & Format(FileCounter / TotFiles, "0%") & " complete."

I'm not sure why. My guess is that it has something to do with "A5" of "Sheet1" showing 0.
Also, I'm not sure how "Dim Count as Integer" applies, which is in the "'Count Files for StatusBar Progress" Section).
Your feedback is greatly appreciated.
 
Upvote 0
Dear Alpha Frog,

Thank you for the rapid response.

The code "breaks" on:
Application.StatusBar = "Processed " & FileCounter & " of " & TotFiles & " files. " & Format(FileCounter / TotFiles, "0%") & " complete."

I'm not sure why. My guess is that it has something to do with "A5" of "Sheet1" showing 0.
Also, I'm not sure how "Dim Count as Integer" applies, which is in the "'Count Files for StatusBar Progress" Section).
Your feedback is greatly appreciated.

delete this lline

Code:
    Do While filenameP <> ""
        [COLOR="#FF0000"]Dim Count As Integer[/COLOR]
        TotFiles = TotFiles + 1
        filenameP = Dir()
    Loop
 
Upvote 0
Dear AlphaFrog,

I deleted: "Dim Count as Integer."
However, "Run-time Error '11' Division by Zero" still shows.
 
Upvote 0
Dear AlphaFrog,

I deleted: "Dim Count as Integer."
However, "Run-time Error '11' Division by Zero" still shows.

Did you copy\pate the code as is without changing anything (except the delete line I suggested)?

Is there any .xlsm files in this folder?
"C:\Users\Daniel\Desktop\Templates\"
 
Last edited:
Upvote 0
Dear AlphaFrog,

Yes, the code works well when pasted as is.
And yes, there are .xlsm files in the folder.

My disconnect was with replacing "wbM" with "ThisWorkbook" as "wbM" plays a role in the "Main Code."
I then figured I would have to replace all "wbM" with "ThisWorkbook" in the "Main Code," which originally contained lines such as:

wbM.Worksheets("sheet2").Range("a10").Value = wbT.Worksheets("sheet2").Range("a10").Value
wbM.Worksheets("sheet2").Range("a14").Value = wbT.Worksheets("sheet2").Range("a14").Value

This replacement, perhaps, is causing "A5" of "Sheet1" to show as 0?
 
Upvote 0
Defining wbM as ThisWorkbook was superfluous. You can go back to using wbM if you want, but that's not the issue now. The problem is it doesn't count any .xlsm files in the folder "C:\Users\Daniel\Desktop\Templates\". I've tested the code (using a different folder), and it works for me.

This test macro should return the name of the first .xlsm file found in your folder.
Code:
[color=darkblue]Sub[/color] Test()
    [color=green]'Define Folder[/color]
    folderPathP = "C:\Users\Daniel\Desktop\Templates\"    [color=green]'change to suit[/color]
    
    [color=darkblue]If[/color] Right(folderPathP, 1) <> "\" [color=darkblue]Then[/color] folderPathP = folderPathP + "\"
    
    [color=green]'Define Filename[/color]
    MsgBox Dir(folderPathP & "*.xlsm")
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
The code works perfectly.
Your patience for my inexcusable ineptitude is commendable: I missed copying the 2nd "filenameP = Dir(folderPathP & "*.xlsm")" under the section "'Create Loop for multiple Files."
Infinite thanks, AlphaFrog.
I never would've figured this out without you.
 
Upvote 0

Forum statistics

Threads
1,223,237
Messages
6,170,924
Members
452,366
Latest member
TePunaBloke

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