create a progress bar for a sequence of macros

[tommy1234]

Hello

I need to create a progress bar (i found the code on the web) for many macros (the macros are running in a sequence).
i have 4 subs, and i want that the progress bar will start when i click the button and will finish when the last macro will finish to run.

Sub code()

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


Sheet5.Cells.Clear


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


End Sub


Sub progress(pctCompl As Single)


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


End Sub

thank you

 

[Worf]

Hello

To use this example, execute the RunMe procedure:

' UserForm module
Private Sub UserForm_activate()
Main
End Sub

Option Explicit
' standard module
Dim Counter#, RowMax#, ColMax#, r%, c%, PctDone#

Sub RunMe()
UserForm1.Show
End Sub

Sub Main()
'   Inserts random numbers on the active worksheet
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    Cells.Clear
    Application.ScreenUpdating = False
    First
    Second
    Third
    Fourth
    Unload UserForm1
End Sub

Sub UpdateBar(start!)
PctDone = start + Counter / (RowMax * ColMax * 4)
With UserForm1
    .FrameProgress.Caption = Format(PctDone, "0%")
    .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
DoEvents
End Sub

Sub First()
Counter = 1
RowMax = 1000
ColMax = 250
For r = 1 To RowMax
    For c = 1 To ColMax
        Cells(r, c) = Int(Rnd * 1000)
        Counter = Counter + 1
    Next
    UpdateBar 0
Next
End Sub

Sub Second()
Counter = 1
RowMax = 500
ColMax = 200
For r = 1 To RowMax
    For c = 1 To ColMax
        Cells(r, c) = Int(Rnd * 1000)
        Counter = Counter + 1
    Next
    UpdateBar 0.25
Next
End Sub

Sub Third()
Counter = 1
RowMax = 800
ColMax = 210
For r = 1 To RowMax
    For c = 1 To ColMax
        Cells(r, c) = Int(Rnd * 1000)
        Counter = Counter + 1
    Next
    UpdateBar 0.5
Next
End Sub

Sub Fourth()
Counter = 1
RowMax = 900
ColMax = 220
For r = 1 To RowMax
    For c = 1 To ColMax
        Cells(r, c) = Int(Rnd * 1000)
        Counter = Counter + 1
    Next
    UpdateBar 0.75
Next
End Sub