frmProgress

The Perfect Progress Bar

A progress bar's purpose is to assure users our program is running and about when it will finish. The perfect progress bar does that and includes an optional Cancel button so users can kill processes that take too long. And it wouldn't be perfect if it wasn't simple to implement in Excel (NOTE! Windows version only!).

What makes this 'perfect'?

The perfect progress bar:

Is just one object in our VBA (a userform) making it easy to import into other projects
Can be called in just 1 line of VBA
Has an optional cancel button to interrupt process that are taking too long
Can display messages in the progress bar and in the userform's title.
Can, in many cases, predict accurately at what time our process will end.

Components

To build the user form we need 5 controls:

frmProgress - The user form
lblBack - A white label behind the expanding bar
lblBar - An expanding gray label
txtBar - A textbox with transparent background where we can display progress messages over the expanding bar.
cmdCancel - An optional command button for killing the process

Properties

Each component has properties that we must set. These dialogs show all properties for each component but there are only a few we must change from the defaults.

Forms and Classes

Forms act like classes. Like classes they have properties; they can expose methods; and we can instantiate them (create instances) by assign them to variables like so:

Dim oPrg as frmProgress

Set oPrg = New frmProgress

This is how I prefer to work with forms, especially this form, because I sometimes have one form displaying overall progress and another displaying a task's progress. By instantiating forms I can have two or more of the same form displayed with each having its own state separate from the others.

Example: Displaying the Form

The code sample below shows how to implement the progress bar with all its 'bells and whistles' (optional features) as well as adding an ETA (estimated time of arrival/completion) calculation.

Sub Test(ByVal lLoops As Long)

' Declarations

Dim oPrg As frmProgress 'User Form

Dim lLoop As Long 'Loop Counter

Dim tBegin As Date 'Timer Begin

Dim tElapsed As Date 'Elapsed Time

Dim tEstimate As Date 'ETA (Estimated time of arrival/completion)

' Error handing

On Error GoTo ErrHandler

' Initialize Variables

Set oPrg = New frmProgress

tBegin = Now()

' Procedure

For lLoop = 1 To lLoops

tElapsed = Now() - tBegin

tEstimate = tBegin + (tElapsed * lLoops) / lLoop

If oPrg .Display(fPercent:=lLoop / lLoops, _

sTitle:="Title goes here", _

sText:="Loop:" & lLoop & " ETA " & _

Format(tEstimate, "h:mm:ss AM/PM"), _

bCancel:=True) = vbCancel Then Exit For

If Err.Number <> 0 Then

MsgBox _

Prompt:="Error#" & Err.Number & vbLf & Err.Description, _

Buttons:=vbCritical + vbMsgBoxHelpButton, _

Title:="frmProgressBar", _

HelpFile:=Err.HelpFile, _

Context:=Err.HelpContext

End If

' Clean Up

If Not oProgress Is Nothing Then oProgress.Hide: Set oProgress = Nothing

End Sub

Creating the form: Module Level Code

After creating the userform's visual components, display its code and enter these procedures. We start with module level code which contains some documentation and creates variables that will be accessible by all routines in this form.

' Version: 12/06/18

' Save as: frmProgress.frm

'Description: Display Progress bar

' Date Ini Modification

' 12/08/11 CWH Redesign

' 04/30/12 CWH Applied new error processing standards

' 05/22/12 CWH Added Progress Bar Text Option

' 06/29/12 CWH Checked for Percent out of range

' 01/02/13 CWH Version 2013.01

' 07/05/13 CWH Switched to clsForm and clsCmd for colors

' 09/03/14 CWH Parameter standardization

' 01/29/14 CWH Encorprated Jon Peltier's UserForm_QueryClose

' 03/14/18 CWH See Display

' 08/21/18 CWH Added cancel option

' 11/02/18 CWH Removed formatting

Option Explicit

' Private Properties

Const cModule As String = "frmProgress" 'This module's name

' Public Properties

Public bCancelled As Boolean 'Cancelled button clicked

Creating the Form: Event Code

This procedure runs when we instantiate the form. I prefer my forms be formatted and so the first two lines connect this form to clsForm (see References at bottom). If you are okay with Excel's gray format, delete those two lines.

Private Sub UserForm_Initialize()

' NOTE! Static - to keep in memory after this routine ends

Static FormClass As New clsForm

Set FormClass.UserForm = Me

bCancelled = False

End Sub

This procedure runs if the user clicks the red X in the upper right corner. This handles that event as if the user clicked cancel.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

' If "X" clicked, cancel unloading. Use hide instead

If CloseMode = vbFormControlMenu Then

Cancel = True

bCancelled = True

Me.Hide

End If

End Sub

This procedure runs when the user clicks Cancel - if it has been enabled.

Private Sub cmdCancel_Click()

bCancelled = True

Me.Hide

End Sub

Creating the Form: Public Methods

This is what our program uses to display the form. See Example: Displaying the Form

Public Function Display(ByVal fPercent As Double, _

Optional ByVal sTitle As String = "", _

Optional ByVal sText As String = "", _

Optional ByVal bCancel As Boolean) As Long

' Description:Mimic VBA's Message Box w/benefits!

' Inputs: Message Text to display

' Title Text for the form's title

' Text Text for the Progress bar

' bCancel Cancel option flag

' Outputs: Display Success: vbOK

' Cancelled: vbCancel

' Example: ? frmProgress.Display(.50, "Validating Entries")

' Date Ini Modification

' 12/08/11 CWH Redesign

' 05/22/12 CWH Added Progress Bar Text Option

' 03/14/18 CWH Changed txtBar colors

' Error Handling and Function initialization

On Error GoTo ErrHandler

Display = vbCancel

' Check Inputs

If fPercent > 1 Then fPercent = 1

If fPercent < 0 Then fPercent = 0

' Procedure

If Not bCancelled Then

If Not Me.Visible Then

Me.cmdCancel.Visible = bCancel

Me.Height = 86 - IIf(bCancel, 0, cmdCancel.Height)

Show vbModeless

End If

Caption = sTitle

txtBar.Text = sText

lblBar.BackColor = RGB(192, 192, 192)

lblBar.Width = txtBar.Width * fPercent

DoEvents

End If

Display = IIf(bCancelled, vbCancel, vbOK)

ErrHandler:

Select Case Err.Number

Case Is = NoError: 'Do nothing

Case Else:

Select Case DspErrMsg(cModule & "." & cRoutine)

Case Is = vbAbort: Stop: Resume 'Debug mode - Trace

Case Is = vbRetry: Resume 'Try again

Case Is = vbIgnore: 'End routine

End Select

' House Keeping

bCancelled = False

End Function

References:
DspErrMsg()
clsForm()