progress bar while in a loop

[leegold2]

Hi,

I'm new to VB and VBA. Say a loop like this:

Sub While_loop()
    ...some code to start an application...
    While Not Application.Initialized()
        'Show a progress bar or something like that
    Wend
    'Now do some stuff
    ...more code...
End Sub

I need to initialize an application before I can start working with it. The while loop test will be true until the app is ready then the loop will exit and the code will continue.

What I'm looking for is the proper widget like a progress bar to show while I'm in the loop. If I used a msgbox I assume it remain even after the loop exits. I'm looking for the way to show a widget while I'm in the loop, then the widget disappears when I get past the loop?

Thanks,

Lee G.

 

[Gavona]

My solution uses the statusbar. It records how long the routine has taken and also records progress in a sheet in the workbook containing a single cell named range "progress". This was to help me review what parts of the process were taking longest.

Example of use within a loop:

Sub xxx()
For Each c In Range("ExcludeList")
    Call StatusMonitor("Applying ExcludeList..." + c.Offset(0, 2).Value)
    If .........
End sub

Dim Start, Finish, TotalTime, ProgressRow As Integer, StatusText As String

Sub DoAllFour()
Start = Timer
ProgressRow = 1
StatusMonitor ("Hello! Starting to do my stuff!")
Call xxx   ' contains various calls to the Statusmonitor routine
Call yyyyyy
Call zzzzzz
Call ResetStatusBar
Finish = Timer
TotalTime = Finish - Start
MsgBox "Routine took " & TotalTime / 60 & "  minutes"
End Sub

Sub ResetStatusBar()
Application.StatusBar = ""
Application.StatusBar = False
Application.DisplayStatusBar = True
End Sub

Sub StatusMonitor(StatusText)
'Displays text in status bar and records progress in progress sheet
Application.StatusBar = StatusText & "        " & Round((Timer - Start) / 60, 2) & "  minutes so far"
ProgressRow = ProgressRow + 1
Range("Progress").Offset(ProgressRow, 0) = Application.StatusBar
Range("Progress").Offset(ProgressRow, 1) = Round((Timer - Start) / 60, 2)
End Sub

If you ever crash out of the routine you need to run the ResetStatusBar routine so that it operates normally.

Gavin