Statusbar

[Matts]

Hi,

I've taken this code from one of the samples available on another website.

In the below sample code, how do i determine/translate the "# of items to
process"
for my project.

There are upto 17 diff worksheets on my current project & on opening the
workbook there are linking/updations/calculations that are done automatically.

With the code as it is, the status bar work fine, but the progress indicator
runs quicker than the actual time that it takes for the entire updation to
happen.
Thsi needs to work cos I've decide to stop the screen flicker as well.

I need the status bar to be in sync with the actual time that the updation
takes.



please advice



Code being used >

Option Explicit

Sub TestBar()
Dim MyTot As Long, i As Long, j As Integer
Application.ScreenUpdating = False ' speed up the macro
Sheets(1).Select ' has records to process
MyTot = 5000 ' # of items to process
i = 0 ' sets startvalue for your index
While i < MyTot ' start your While .. Wend, Do .. Loop or For .. Next
i = i + 1 ' increase your index / activate your next item
StatBar i, MyTot, "Processing", True ' display statusbar
For j = 1 To 10000: Next j ' remove this line from your code to
speed up processing
' do something ...
' do something else ...
Wend ' start processing next item
Application.StatusBar = False ' remove statusbartext
End Sub


Sub StatBar(MyIndex As Long, MyTotal As Long, MyText As String, InclPercent
As Boolean)
Const NumBars As Integer = 30 ' # of characters in the bar
Const FillChar As String * 1 = "•" ' alt+0149 or try out your own character
Const DoneChar As String * 1 = "»" ' alt+0187 or try out your own character
Dim PctDone As Integer, FBar As Integer, BBar As Integer, BarText As String
If MyIndex Mod CInt((MyTotal * 0.01)) <> 0 Then Exit Sub
' previous line speeds up the macro by not updating the statusbar for
every single record
If MyText <> Empty Then BarText = MyText & " " Else BarText = Empty
PctDone = CInt((MyIndex / MyTotal) * 100)
FBar = CInt(PctDone / 100 * NumBars)
BBar = NumBars - FBar
If InclPercent Then
BarText = BarText & " " & PctDone & " % "
End If
Application.StatusBar = BarText & Application.Rept(DoneChar, FBar) &
Application.Rept(FillChar, BBar)
End Sub

 

[Mike H.]

Here is what I do: Trial and Error. I determine the "mostly likely"
scenario of what data will get processed and then I call a function by
setting up a couple public variables:

Private Function UpdateUF1(pctdone As Double, Caption As String)
'this updates the progress bar ont he first update progress box.
On Error GoTo 0
With UserForm1
If pctdone > 1 Then
pctdone = 1 - 0.02
End If
.FrameProgress.Caption = Format(pctdone, "0%")
.LabelProgress.Width = pctdone * (.FrameProgress.Width - 10)
.Label1.Caption = Caption
End With
DoEvents
End Function

Then if the thing finishes too fast, as you say, I adjust the way I build up
the value of PCTDONE. Then I run it again until it is about right. And if
there are options that the user can select which affects the iterations of
running stuff, I try to take that into account and adjust accordingly also.
Also, note, if I get above 1, I pare it back to 98%. Good luck! I have mine
where they are what I'd call perfect. Actually much better than the progress
bars you get with a lot of stuff!

 

[Matts]

Hi Mike,
I do not have a Userform on this workbook atall.
I see the progree bar happenening on the bottom of the screen. How does your
code change now ?

 

[Mike H.]

You have the same thing. In your case the entire issue becomes what is the
value of i that you are passing (MyIndex when passed) because i is the
numerator in your calculation. So you just have to vary the way you
increment it. Not very scientific but that is truly all you have to do.
Maybe you have to reduct how fast it increments or increase the size of the
denominator, MyTotal. HTH