How to enter progress bar

[abidraza]

Sub UpdatePurchase()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Sheets("Main")

.Range("I4:I4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$4)"
.Range("J4:J4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$4)"

.Range("L4:L4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$5)"
.Range("M4:M4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$5)"

.Range("O4:O4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$6)"
.Range("P4:P4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$6)"

.Range("I4:P4203").Calculate

With .Range("I4:P4203")
.Value = .Value
End With
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Ruddles]

Create an ActiveX progress bar on your worksheet called ProgressBar1.

Make the following changes to your code:-

Sub UpdatePurchase()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Sheets("Main")
[COLOR=red]  .ProgressBar1.Activate
  .ProgressBar1.Visible = True
  .ProgressBar1.Value = 0
  .ProgressBar1.Min = 0
  .ProgressBar1.Max = 8[/COLOR]
[COLOR=red]
[/COLOR].Range("I4:I4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$4)"
[COLOR=red].ProgressBar1 = .ProgressBar1.Value + 1
[/COLOR].Range("J4:J4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$4)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

.Range("L4:L4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$5)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]
.Range("M4:M4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$5)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

.Range("O4:O4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$6)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]
.Range("P4:P4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$6)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

.Range("I4:P4203").Calculate
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

With .Range("I4:P4203")
.Value = .Value
End With
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
  [COLOR=red]MsgBox "Done!"
  .ProgressBar1.Visible = False
[/COLOR]
End Sub

This just places the progress bar updates at eight arbitrary points in the code. Is there one particular part of the code which you want to show the progress bar for? (Don't say "the recalculation"!)

 

[abidraza]

Create an ActiveX progress bar on your worksheet called ProgressBar1.

Make the following changes to your code:-

Sub UpdatePurchase()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Sheets("Main")
[COLOR=red]  .ProgressBar1.Activate
  .ProgressBar1.Visible = True
  .ProgressBar1.Value = 0
  .ProgressBar1.Min = 0
  .ProgressBar1.Max = 8[/COLOR]
[COLOR=red]
[/COLOR].Range("I4:I4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$4)"
[COLOR=red].ProgressBar1 = .ProgressBar1.Value + 1
[/COLOR].Range("J4:J4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$4)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

.Range("L4:L4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$5)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]
.Range("M4:M4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$5)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

.Range("O4:O4203").Formula = "=SUMIFS(Entry!$I$4:$I$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$6)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]
.Range("P4:P4203").Formula = "=SUMIFS(Entry!$J$4:$J$65557,Entry!$F$4:$F$65557,Main!E4,Entry!$H$4:$H$65557,Heads!$B$6)"
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

.Range("I4:P4203").Calculate
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]

With .Range("I4:P4203")
.Value = .Value
End With
[COLOR=#ff0000].ProgressBar1 = .ProgressBar1.Value + 1[/COLOR]
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
  [COLOR=red]MsgBox "Done!"
  .ProgressBar1.Visible = False
[/COLOR]
End Sub

This just places the progress bar updates at eight arbitrary points in the code. Is there one particular part of the code which you want to show the progress bar for? (Don't say "the recalculation"!)

Thanks Ruddles,
please guide me to make form of progress bar

 

[abidraza]

Sub Test()
' The UserForm1_Activate sub calls Main
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub

Sub Main()
' Inserts random numbers on the active worksheet
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer, c As Integer
Dim PctDone As Single

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Cells.Clear
Application.ScreenUpdating = False
Counter = 1
RowMax = 100
ColMax = 25
For r = 1 To RowMax
For c = 1 To ColMax
Cells(r, c) = Int(Rnd * 1000)
Counter = Counter + 1
Next c
PctDone = Counter / (RowMax * ColMax)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
Next r
Unload UserForm1
End Sub


How to enter the above code in the this code

 

[Ruddles]

Thanks Ruddles,
please guide me to make form of progress bar

Go Developer > Insert, then under ActiveX Controls, click the More Controls icon (crossed hammer and spanner). Look for anything which says '(Microsoft) Progress Bar/Control', select that and click OK.

Click-and-hold on your worksheet, then drag-and-release to place the progress bar. Don't worry too much about size and position as you can change these later.

Make a note of the name of the progress bar as you will be needing that later when you write your code.

 

[Ruddles]

How to enter the above code in the this code

Here are some notes I prepared earlier:-

There are three elements to using a progress bar:-

1. Setting up the initial values and displaying the bar if it is hidden
2. Incrementing the value of the bar
3. Optionally, hiding it again when you have finished with it

I will describe these steps and provide sample code. I shall assume the bar is called ProgressBar1.

1) Setting up the initial values and displaying the bar

In order to use a progress bar sensibly, you must know in advance how many times you are going to increment its value. For example, if you
know that you are processing 100 records or that you are looping round 100 times for some other purpose, then you will be incrementing the
value of the bar 100 times.

If you do not know in advance exactly how many times you will be incrementing it, you may be able to find out (for example, by whipping through a recordset once in advance and counting the records) or by estimating based on experience. Obviously if your estimate is wildly inaccurate then the user will end up watching an unreliable progress bar.

Let's assume you've worked out how many times you're going to increment the bar's value and that the number is stored in intLoops. Place this
code somewhere at the start of your procedure before you start looping through your records:-

With Sheets("Sheet1")
    .ProgressBar1.Visible = True
    .ProgressBar1.Value = 0
    .ProgressBar1.Min = 0
    .ProgressBar1.Max = intLoops
End With

2) Incrementing the value of the bar

Locate the loop which executes intLoops times. Somewhere near the end of this loop, place the following code:-

With Sheets("Sheet1")
    If .ProgressBar1.Value < .ProgressBar1.Max Then
        .ProgressBar1 = .ProgressBar1.Value + 1
    End If
End With

Note that we test that we're not going to break the maximum value of the bar as this would raise a VBA error.

3) Hiding the bar when you have finished with it

Somewhere after the main loop has ended - perhaps just after where you're informing the user that the run has finished - place the following code:-

With Sheets("Sheet1")
    .ProgressBar1 = .ProgressBar1.Max ' to make sure it's at 100%
End With

MsgBox "Done!"

With Sheets("Sheet1")
    .ProgressBar1.Visible = False
End With

 

[Ruddles]

In the case of your code, your main loop appears to be For r = 1 To RowMax, so you would set ProgressBar1.Max equal to RowMax and increment the value of the bar just before you do Next r.