Amend progress bar code

Here's a workbook that now has a working progress bar. One of the problems was that lines 46 and 47 above used 'value' for a variable name but that is an Excel reserved word so it caused problems. Click the 'Start' button to start the clock. Here's the userform code. Note the comment at lines 19 and 20. Note also that the progress bar could be made to progress more smoothly and still take 10 minutes to continue.

Option Explicit

Dim Cancelled As Boolean, showTime As Boolean, showTimeLeft As Boolean
Dim startTime As Long
Dim BarMin As Long, BarMax As Long, BarVal As Long
Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Sub cmdStart_Click()
Dim lngLoop As Long
Dim tmr As Long

Configure "My test", "Working...", 1, 10, "Cancel", True, True
SetValue 1

For lngLoop = 1 To 10
    SetValue lngLoop
 
    'Our finish time
    ' The '5' here indicates 5 seconds which I used for testing. If
    ' you want to wait 1 minute change it to 60.
    tmr = GetTickCount + (5 * 1000)
    'If our current time is less than the finish, then doevents
    While GetTickCount < tmr
        If Cancelled Then
            ProgressBar.Width = 0
            lblPct.Caption = ""
            Exit Sub
        End If
        DoEvents
    Wend
Next

MsgBox "Done"

End Sub

'Title will be the title of the dialogue.
'Status will be the label above the progress bar, and can be changed with SetStatus.
'Min is the progress bar minimum value, only set by calling configure.
'Max is the progress bar maximum value, only set by calling configure.
'CancelButtonText is the caption of the cancel button. If set to vbNullString, it is hidden.
'optShowTimeElapsed controls whether the progress bar computes and displays the time elapsed.
'optShowTimeRemaining controls whether the progress bar estimates and displays the time remaining.
'calling Configure sets the current value equal to Min.
'calling Configure resets the current run time.
Public Sub Configure(ByVal title As String, ByVal status As String, _
                     ByVal Min As Long, ByVal Max As Long, _
                     Optional ByVal CancelButtonText As String = "Cancel", _
                     Optional ByVal optShowTimeElapsed As Boolean = True, _
                     Optional ByVal optShowTimeRemaining As Boolean = True)
    Me.Caption = title
    lblStatus.Caption = status
    BarMin = Min
    BarMax = Max
    BarVal = Min
    'CancelButton.Visible = Not CancelButtonText = vbNullString
    CancelButton.Caption = CancelButtonText
    startTime = GetTickCount
    showTime = optShowTimeElapsed
    showTimeLeft = optShowTimeRemaining
    lblRunTime.Caption = ""
    lblRemainingTime.Caption = ""
    Cancelled = False
End Sub

'Set the label text above the status bar
Public Sub SetStatus(ByVal status As String)
    lblStatus.Caption = status
    DoEvents
End Sub

'Set the value of the status bar, a long which is snapped to a value between Min and Max
Public Sub SetValue(ByVal lngValue As Long)
    If lngValue < BarMin Then lngValue = BarMin
    If lngValue > BarMax Then lngValue = BarMax
    Dim progress As Double, runTime As Long
    BarVal = lngValue
    progress = (BarVal - BarMin) / (BarMax - BarMin)
    ProgressBar.Width = progress * lblPct.Width
    lblPct.Caption = Int(progress * 10000) / 100 & "%"
    
    runTime = GetRunTime()
    If showTime Then lblRunTime.Caption = "Time Elapsed: " & GetRunTimeString(runTime, True)
    If showTimeLeft And progress > 0 Then
        lblRemainingTime.Caption = "Est. Time Left: " & GetRunTimeString(runTime * (1 - progress) / progress, False)
    End If
    DoEvents
End Sub

'Get the time (in milliseconds) since the progress bar "Configure" routine was last called
Public Function GetRunTime() As Long
    GetRunTime = GetTickCount - startTime
End Function

'Get the time (in hours, minutes, seconds) since "Configure" was last called
Public Function GetFormattedRunTime() As String
    GetFormattedRunTime = GetRunTimeString(GetTickCount - startTime)
End Function

'Formats a time in milliseconds as hours, minutes, seconds.milliseconds
'Milliseconds are excluded if showMsecs is set to false
Private Function GetRunTimeString(ByVal runTime As Long, Optional ByVal showMsecs As Boolean = True) As String
    Dim msecs&, hrs&, mins&, secs#
    msecs = runTime
    hrs = Int(msecs / 3600000)
    mins = Int(msecs / 60000) - 60 * hrs
    secs = msecs / 1000 - 60 * (mins + 60 * hrs)
    GetRunTimeString = IIf(hrs > 0, hrs & "  ", "") _
                     & IIf(mins > 0, mins & " minutes ", "") _
                     & IIf(secs > 0, IIf(showMsecs, secs, Int(secs + 0.5)) & " seconds", "")
End Function

'Returns the current value of the progress bar
Public Function GetValue() As Long
    GetValue = BarVal
End Function

'Returns whether or not the cancel button has been pressed.
'The ProgressDialogue must be polled regularily to detect whether cancel was pressed.
Public Function cancelIsPressed() As Boolean
    cancelIsPressed = Cancelled
End Function

'Recalls that cancel was pressed so that they calling routine can be notified next time it asks.
Private Sub CancelButton_Click()
    Cancelled = True
    lblStatus.Caption = "Cancelled By User"
End Sub

Private Sub UserForm_Initialize()
ProgressBar.Move lblPct.Left, lblPct.Top, 0, lblPct.Height

End Sub

Select allOpen in new window

Q-28492425.xlsm

Perfect!

Thanks

You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014