Using progress bar with existing loop

[Jeff Roper]

Hello, I need to know how to enter a loop into this module listed below
The loop is listed below this module.

Sub ProgBarDemo()
Dim PB As clsProgBar
Dim nCounter As Integer
Dim lWaitCount As Long

Set PB = New clsProgBar

With PB
.Title = "Enhanced Datasystems Progress Bar"
.Caption2 = "This is caption 2"
.Caption3 = "This is caption 3"
.Show

For nCounter = 0 To 100

.Progress = nCounter
.Caption1 = "Progress message " & CStr(nCounter)

For lWaitCount = 0 To 1000000

If UserCancelled = True Then GoTo EndRoutine

Next lWaitCount

Next nCounter

EndRoutine:

.Finish

End With

Set PB = Nothing

End Sub

----------------------------------------
** Loop ** -- Changes a percentage (M7) + or - .000001 to make on
number (J16) equal another (L16).
----------------------------------------

Application.ScreenUpdating = False 'Part of screen flashin
turn-off

Range("M7").Value = 0.09 'Set value of cell "M7"

If Range("J16") < Range("L16") Then 'Test for condition <
Do While Not Range("J16") = Range("L16")
Range("M7") = Range("M7") + 0.000001
Loop
ElseIf Range("J16") > Range("L16") Then 'Test for condition >
Do While Not Range("J16") = Range("L16")
Range("M7") = Range("M7") - 0.000001
Loop
End If

Range("K16").Interior.ColorIndex = 50 'Change color of equa
signs
Range("J7").Interior.ColorIndex = 50 'Change color of Total
Range("L14:L15").Interior.ColorIndex = 50 'Change color of Gran
Total

Application.ScreenUpdating = True 'Part of screen flashin
turn-of

 

[Robin Hammond]

Jeff,

The progbar class or any progress bar typically is designed to handle a
known number of iterations. What you are trying to do looks like a general
convergence algorithm without a known limit, but without the spreadsheet
it's hard to tell. What you could do is show the progress bar moving
continuously while you are running the convergence, or just update the
captions rather than the bars. The latter is probably better but I have
shown both below.

Sub Convergence
Dim PB as clsProgBar
Dim nCounter as integer

Set PB = new clsProgBar

Range("M7").Value = 0.09 'Set value of cell "M7"
nCounter = 0

with PB
.Title = "Jeff's test"
.Show
DoEvents 'not strictly necessary but sometimes helps

If Range("J16") < Range("L16") Then 'Test for condition <
Do While Not Range("J16") = Range("L16")
.Caption1 = "Changing M7 to " & cstr(Range("M7").Value +
0.000001)
nCounter = (nCounter +1) MOD 100
.Progress = nCounter
Range("M7") = Range("M7") + 0.000001
ActiveSheet.Calculate
Loop
ElseIf Range("J16") > Range("L16") Then 'Test for condition >
Do While Not Range("J16") = Range("L16")
.Caption1 = "Changing M7 to " & cstr(Range("M7").Value -
0.000001)
nCounter = (nCounter +1) MOD 100
.Progress = nCounter
Range("M7") = Range("M7") - 0.000001
ActiveSheet.Calculate
Loop
End If
End With
PB.Finish
Set PB = nothing
End Sub

I hope you find it useful.

Robin Hammond
www.enhanceddatasystems.com