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,

You'll need to integrate this code with the code that is doing the iterative copying. That will need to include a UserForm1.Show call to display your userform.

Just post the code that does the copying if you want some help with that.

 

[Johnny Thunder]

Hi @Jerry Sullivan , Thank you for your response and your help on this. So for my copy macro, it runs in a loop so I am hoping that the code for the progress bar will also loop so that during the time the code is running it is also visually updating the progress bar until the code stops.

Sub Copy_CCodes()
  
  Dim Lastrow       As Long
  Dim Datastore     As Worksheet
  Dim FinalDest     As Worksheet
  Dim rCell         As Range
  
  Set Datastore = Sheets("Lookups2")
  Set FinalDest = Sheets("Summary")


Lastrow = Datastore.Cells(Rows.Count, "O").End(xlUp).Row
  
Call FindRep
  
For Each rCell In Datastore.Range("O2:O" & Lastrow)
  
  If rCell <> "" Then
            
Application.ScreenUpdating = False
Application.DisplayAlerts = False
            
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
                       
    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
  
 End Sub

Hi Johnny Thunder,

You'll need to integrate this code with the code that is doing the iterative copying. That will need to include a UserForm1.Show call to display your userform.

Just post the code that does the copying if you want some help with that.

 

[Jerry Sullivan]

Try replacing your existing Copy_CCodes Sub with the code below.

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

 Lastrow = Datastore.Cells(Rows.Count, "O").End(xlUp).Row
 TotalCount = Lastrow - 1
  
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
  
 Call FindRep

 UserForm1.Show
 
 For Each rCell In Datastore.Range("O2:O" & Lastrow)
   Counter = Counter + 1
   
   If rCell <> "" Then
                       
      FinalDest.Range("RPTCC").Value = rCell.Value
      progress pctCompl:=100 * Counter / TotalCount
      
      Call FindColVal

      Calculate
            
      Call SaveSheet ' Just saves the new workbooks with the copy values as an .xlsx and to a specific directory
                       
   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

These two procedures (which are unchanged from the example you linked), should also be in the same Standard Code Module (not the Userform1 module).

Sub code()

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

 Sheet1.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

The only code that should be in the UserForm1 Module is this...

Private Sub UserForm_Activate()

 code

End Sub

 

[Jerry Sullivan]

I'd suggest a change to the tutorial code that you linked...

In Sub "code", change this statement...

Cells(i, 1).Value = j

to read...

Sheet1.Cells(i, 1).Value = j

Be aware the tutorial code assumes that you have a worksheet with codename "Sheet1" and it uses that sheet write and clear numbers to create a delay. If you have other data on Sheet1, the code will overwrite that!

 

[Johnny Thunder]

@Jerry Sullivan , Thank you for your help on this project. I have modified my original CopyCode with your revisions.

I am now working on the progress bar loop and need some guidance on it.

Below is the code that I have that was intended for the progress bars percentage. I have the named range Range("PrgB") that defines the percentage that code has ran based on a simple math formula. I have 67 copy/paste that occur (this is based on a dynamic list).

So the code below will return the percentage but I am not sure how to trigger it to update the progress bar each loop from the CopyCC macro that you helped revise? Any ideas?

Sub Code1()


Dim pctCompl As Single
Dim Nm1 As Range


Set Nm1 = Range("PrgB")


pctCompl = Int(Nm1)


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


DoEvents


End Sub

I'd suggest a change to the tutorial code that you linked...

In Sub "code", change this statement...

Cells(i, 1).Value = j

to read...

Sheet1.Cells(i, 1).Value = j

Be aware the tutorial code assumes that you have a worksheet with codename "Sheet1" and it uses that sheet write and clear numbers to create a delay. If you have other data on Sheet1, the code will overwrite that!

 

[Jerry Sullivan]

The Copy_CCodes modifications I suggested calculate the percentage complete. You don’t need that named range, and you should delete your Code1 procedure.

 

[pvr928]

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

 

[Johnny Thunder]

@Jerry Sullivan

Thanks again for all the help. If there is no need for Code1, how would I modify the CopyCCodes macro to trigger your counter? I marked the line in the code below that would end up getting deleted if I am no longer using the Code or Code1 macro.

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

 Lastrow = Datastore.Cells(Rows.Count, "O").End(xlUp).Row
 TotalCount = Lastrow - 1
  
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
  
 Call FindRep

 UserForm1.Show
 
 For Each rCell In Datastore.Range("O2:O" & Lastrow)
   Counter = Counter + 1
   
   If rCell <> "" Then
                       
      FinalDest.Range("RPTCC").Value = rCell.Value
      progress pctCompl:=100 * Counter / TotalCount   <------------------------ this line comes from the Code Macro from the link I originally posted
      
      Call FindColVal

      Calculate
            
      Call SaveSheet ' Just saves the new workbooks with the copy values as an .xlsx and to a specific directory
                       
   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

The Copy_CCodes modifications I suggested calculate the percentage complete. You don’t need that named range, and you should delete your Code1 procedure.

 

[Jerry Sullivan]

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