VBA - Creating a Progress Bar While Macro is Running

[Johnny Thunder]

Hello all,

Working on a new type of code for creating a Userform Progress Bar. Never done anything like this before so bare with me.

I found this article on the web as a start to create the userform and bar visually - http://www.excel-easy.com/vba/examples/progress-indicator.html

And it was a great help to get started but now I am stuck with writing the code that will display the actually bar progress.

Currently, I have a cell, a named range that tells the current status of the code based on how many times a value is placed into a cell that will be copied approx 68 times.

I was hoping to use this named range into the code for the progress bar to display the current progress % but nothing happens when I execute? Not sure what I am doing wrong.

Below is the code that is in my Userform along with the Sub I wrote to display the named range as the progress percentage. Nothing happens when I execute though? No screen flicker, no user form display, nothing....

Private Sub UserForm_Activate()


Code


End Sub



Sub Code()


Dim pctCompl As Single


pctCompl = Range("PrgB").Value
 
UserForm1.Text.Caption = pctCompl & "% Completed"
UserForm1.Bar.Width = pctCompl * 2


DoEvents


End Sub

 

[Jerry Sullivan]

Hi @Johnny Thunder

Left field, but I would question the need to have a bar showing progress, and instead focus on making the underlying macro run faster. If you have a blisteringly fast macro, you won't need an indicator to show its progress !

Also, operating the progress bar will necessarily slow the speed of the macro down.

If you must have a progress bar, contemplate using the Status Bar instead of a UserForm: http://www.excel-easy.com/vba/examples/statusbar.html

Cheers

pvr928

I agree!

 

[Johnny Thunder]

@Jerry Sullivan

I am getting an error on this line below, I am assuming it errors out because this line is part of the Code Macro.

I think the confusion is coming from 2 places,

The userform code shows: You suggested that I remove the Code Macro so I did, if this needs to be replaced with anything what would go here?

Private Sub UserForm_Activate()

 code

End Sub

2nd confusion, - Your comments about the modified Copy_CCodes Macro has code to do the counter, now that I deleted the Code Macro, does the user form above need to have the Copy_CCodes macro in the Userform in place of the line Code​?

progress pctCompl:=100 * Counter / TotalCount   <------------------------ Sub or function not defined

What happened when you tried running the code I suggested? It triggers the progress bar and it shouldn’t need any modifications.

 

[Jerry Sullivan]

You need to have all 3 procedures the Standard Code Module that I noted post #4 . That includes the sub "code". You need delete the old "code" Sub that you had in the UserForm1.

Don't modify the Sub UserForm_Activate. It should call code (not Copy_CCodes).

 

[Johnny Thunder]

@Jerry Sullivan

So I put all three codes back in as you suggested and reran the code, this is what happens.

1. The Code script runs and clears my blank sheet 1 and then adds the value 1000 to 100 rows, as the code suggests (I don't need any of this code, but it does show how the progress bar should work)
2. Then the Copy_CCcode begins and shows the Progress bar and has the counter displaying the percentage of progress formatted weird like 1.111777% as opposed to 1%.
3. The Copy_CCode takes about 2-3min to run 1 file, without the progress bar code the macro was able to loop thru 67 loops essentially creating 67 new workbooks in less than 10min.
4. The progress bar doesn't seem to be staying on the screen, it comes and goes.

I feel like we are getting really close but the Code code definitely needs some modification, since I don't need the whole paste 100 rows of the value 1000. the lower portion of code Progress is needed since your revisions to my Copy_CCodes is referencing that macro. I pasted the code below for review.

I really appreciate all the help on this Jerry, I know we are all busy in our day.

Sub code()


Dim i As Integer, j As Integer, pctCompl As Single


 Sheets("Notes").Cells.Clear


For i = 1 To 100
     For j = 1 To 1000
         Cells(i, 1).Value = j
     Next j
     pctCompl = i
     progress pctCompl
Next i


End Sub
---------------------------------------------------------------------------------------------------------------------------
Sub progress(pctCompl As Single)


 UserForm1.Text.Caption = pctCompl & "% Completed"
 UserForm1.Bar.Width = pctCompl * 2


 DoEvents


End Sub

 

[Jerry Sullivan]

Okay, good to hear we are making progress.

The purpose of the code in the tutorial that writes 1-1000 100 times in Sheet1 is simply to ensure that the progress bar doesn't get displayed, then disappear so fast that you don't see it. Since each iteration of your code takes at least a few seconds, that isn't really needed.

Since we are changing the tutorial code significantly, I've rewritten that in a way that I find clearer.

Replace all the previous code with this...
In Userform1:

'--userform module variables
Private mlPercentComplete As Long

'--public properties
Public Property Let PercentComplete(lPctComplete As Long)
   mlPercentComplete = lPctComplete
End Property


Public Sub Refresh()
 With Me
   .Text.Caption = mlPercentComplete & "% Completed"
   .Bar.Width = mlPercentComplete * 2
 End With
 DoEvents
End Sub

In the Standard Module:

Public Sub Copy_CCodes()
 Dim Lastrow       As Long
 Dim Counter       As Long
 Dim TotalCount    As Long
 Dim rCell         As Range
 Dim frm           As UserForm1
 Dim Datastore     As Worksheet
 Dim FinalDest     As Worksheet
 
 Set Datastore = Sheets("Lookups2")
 Set FinalDest = Sheets("Summary")

 Lastrow = Datastore.Cells(Rows.Count, "O").End(xlUp).Row
 TotalCount = Lastrow - 1
  
 '--create a new instance
 Set frm = New UserForm1
 
 '--pass initial value to public property of frm
 frm.PercentComplete = 0
 
 '--show form non-modal
 frm.Show False

 Application.ScreenUpdating = True
 Application.DisplayAlerts = False
  
 
 For Each rCell In Datastore.Range("O2:O" & Lastrow)
   Counter = Counter + 1
   
   If rCell <> "" Then
                       
      FinalDest.Range("RPTCC").Value = rCell.Value
      
      
  '    Call FindColVal

  '    Calculate
            
  '    Call SaveSheet ' Just saves the new workbooks with the copy values as an .xlsx and to a specific directory
                       
      '--update percentcomplete
       frm.PercentComplete = Round(100 * Counter / TotalCount, 0)
       frm.Refresh

   End If
                       
 Next rCell
    
' Call CountFiles  ' Once the code is done, this code looks at the folder with all the newly saved workbooks
                  ' and counts to ensure all were created

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True


End Sub

You'll notice that I commented out the procedure calls like FindColVal that you haven't posted. Run this code as is first. It should complete very quickly, ending with the progress bar displayed at 100%. It will have skipped over all your function calls.

If that works, then try uncommenting 1 function call at a time to make sure it works, and that the progress bar doesn't disappear or flicker excessively. I'd recommend you remove any Application.ScreenUpdating statements from your called procedures and just let the top level Sub, Copy_CCodes handle that by setting it to False at the beginning and True at the end.

 

[Johnny Thunder]

This is awesome!

I am going to work on this now and let you know how it goes tomorrow morning. Thanks again for all the help.

 

[Johnny Thunder]

@Jerry Sullivan

Weird without any mods to the code and pasting it in per your instruction and when I trigger the code, it automatically shows the progress bar at 97% and just stays there?

 

[Jerry Sullivan]

With your calls skipped over, the code should run so fast that you won't see any change in the progress bar, just the final status.

When you start adding back your procedure calls, you should see the progress bar advance from 0 to 100.

I expected the final progress bar status to be 100%. It if reads 97%, it might be that you have a formula blank in the last cell of Column O.

Try this slightly modified version that moves the progress bar outside the test for rCell<>"".

Public Sub Copy_CCodes()
 Dim Lastrow       As Long
 Dim Counter       As Long
 Dim TotalCount    As Long
 Dim rCell         As Range
 Dim frm           As UserForm1
 Dim Datastore     As Worksheet
 Dim FinalDest     As Worksheet
 
 Set Datastore = Sheets("Lookups2")
 Set FinalDest = Sheets("Summary")

 Lastrow = Datastore.Cells(Rows.Count, "O").End(xlUp).Row
 TotalCount = Lastrow - 1
  
 '--create a new instance
 Set frm = New UserForm1
 
 '--pass initial value to public property of frm
 frm.PercentComplete = 0
 
 '--show form non-modal
 frm.Show False

 Application.ScreenUpdating = True
 Application.DisplayAlerts = False
  
 
 For Each rCell In Datastore.Range("O2:O" & Lastrow)
   Counter = Counter + 1
   
   If rCell <> "" Then
                       
      FinalDest.Range("RPTCC").Value = rCell.Value
      
      
  '    Call FindColVal

  '    Calculate
            
  '    Call SaveSheet ' Just saves the new workbooks with the copy values as an .xlsx and to a specific directory
                       
   End If
                       
   '--update percentcomplete
   frm.PercentComplete = Round(100 * Counter / TotalCount, 0)
   frm.Refresh
 
 Next rCell

' Call CountFiles  ' Once the code is done, this code looks at the folder with all the newly saved workbooks
                  ' and counts to ensure all were created

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
End Sub

 

[Johnny Thunder]

@Jerry Sullivan

The revised code worked out great! Thank you so much for all the help!