A reusable ProgressIndicator

Question

There was a Tweet from @ExcelEasy earlier this week, that linked to this article, to which I replied with a little challenge:

@ExcelEasy well done! #Challenge: make a more #OOP one without using the form's default/global instance! #becausewhynot

Of course I wouldn't just leave it at that, so here's my own implementation:

---

UserForm: ProgressView

The form itself isn't responsible for anything other than updating itself and notifying the ProgressIndicator when it's ready to start reporting progress, or when the user clicked the red "X" button to cancel the action in progress.

I kept it simple, but flexible enough to allow the ProgressIndicator and its client code change its caption and label as needed.

Option Explicit
Private Const PROGRESSBAR_MAXWIDTH As Integer = 224

Public Event Activated()
Public Event Cancelled()

Private Sub UserForm_Activate()
    ProgressBar.Width = 0 ' it's set to 10 to be visible at design-time
    RaiseEvent Activated
End Sub

Public Sub Update(ByVal percentValue As Single, Optional ByVal labelValue As String, Optional ByVal captionValue As String)
    
    If labelValue <> vbNullString Then
        ProgressLabel.Caption = labelValue
    End If
    
    If captionValue <> vbNullString Then
        Me.Caption = captionValue
    End If
    
    ProgressBar.Width = percentValue * PROGRESSBAR_MAXWIDTH
    DoEvents
    
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        Cancel = True
        RaiseEvent Cancelled
    End If
End Sub

---

Class: ProgressIndicator

That's where the logic is. I've set it up with reasonable defaults, so that it's usable with minimal configuration. I'm including the actual text file, because this class (and the form) is meant to be defined in an Excel add-in (.xlam), so that it's available to every VBA project; as such, it's Public, not creatable, which makes it impossible to instantiate from client code - that's why I've set the PredeclaredId attribute to True and included a factory method:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ProgressIndicator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const DEFAULT_CAPTION As String = "Progress"
Private Const DEFAULT_LABEL As String = "Please wait..."

Private Const ERR_NOT_INITIALIZED As String = "ProgressIndicator is not initialized."
Private Const ERR_PROC_NOT_FOUND As String = "Specified macro or object member was not found."
Private Const ERR_OPERATION_CANCELLED As String = "Operation was cancelled by the user."

Public Enum ProgressIndicatorError
    Error_NotInitialized = vbObjectError + 1001
    Error_ProcedureNotFound
    Error_OperationCancelled
End Enum

Private Type TProgressIndicator
    procedure As String
    instance As Object
    sleepDelay As Long
End Type

Private this As TProgressIndicator
Private WithEvents view As ProgressView
Attribute view.VB_VarHelpID = -1

Private Sub Class_Initialize()
    Set view = New ProgressView
    view.Caption = DEFAULT_CAPTION
    view.ProgressLabel = DEFAULT_LABEL
End Sub

Private Sub Class_Terminate()
    Set view = Nothing
    Set this.instance = Nothing
End Sub

Private Function QualifyMacroName(ByVal book As Workbook, ByVal procedure As String) As String
    QualifyMacroName = "'" & book.FullName & "'!" & procedure
End Function

Public Function Create(ByVal procedure As String, Optional instance As Object = Nothing, Optional ByVal initialLabelValue As String, Optional ByVal initialCaptionValue As String, Optional ByVal completedSleepMilliseconds As Long = 1000) As ProgressIndicator
    
    Dim result As New ProgressIndicator
    
    result.SleepMilliseconds = completedSleepMilliseconds
    
    If Not instance Is Nothing Then
        Set result.OwnerInstance = instance
    ElseIf Not Framework.Strings.Contains(procedure, "'!") Then
        procedure = QualifyMacroName(Application.ActiveWorkbook, procedure)
    End If
    
    result.ProcedureName = procedure
    
    If initialLabelValue <> vbNullString Then
        result.ProgressView.ProgressLabel = initialLabelValue
    End If
    
    If initialCaptionValue <> vbNullString Then
        result.ProgressView.Caption = initialCaptionValue
    End If
    
    Set Create = result
    
End Function

Friend Property Get ProgressView() As ProgressView
    Set ProgressView = view
End Property

Friend Property Get ProcedureName() As String
    ProcedureName = this.procedure
End Property

Friend Property Let ProcedureName(ByVal value As String)
    this.procedure = value
End Property

Friend Property Get OwnerInstance() As Object
    Set OwnerInstance = this.instance
End Property

Friend Property Set OwnerInstance(ByVal value As Object)
    Set this.instance = value
End Property

Friend Property Get SleepMilliseconds() As Long
    SleepMilliseconds = this.sleepDelay
End Property

Friend Property Let SleepMilliseconds(ByVal value As Long)
    this.sleepDelay = value
End Property

Public Sub Execute()
    view.Show vbModal
End Sub

Public Sub Update(ByVal percentValue As Single, Optional ByVal labelValue As String, Optional ByVal captionValue As String)

    On Error GoTo CleanFail
    ThrowIfNotInitialized

    ValidatePercentValue percentValue
    view.Update percentValue, labelValue

CleanExit:
    If percentValue = 1 Then Sleep this.sleepDelay
    Exit Sub

CleanFail:
    MsgBox Err.Number & vbTab & Err.Description, vbCritical, "Error"
    Resume CleanExit
End Sub

Public Sub UpdatePercent(ByVal percentValue As Single, Optional ByVal captionValue As String)
    ValidatePercentValue percentValue
    Update percentValue, Format(percentValue, "0.0% Completed")
End Sub

Private Sub ValidatePercentValue(ByRef percentValue As Single)
    If percentValue > 1 Then
        percentValue = percentValue / 100
    End If
End Sub

Private Sub ThrowIfNotInitialized()
    If this.procedure = vbNullString Then
        Err.Raise ProgressIndicatorError.Error_NotInitialized, TypeName(Me), ERR_NOT_INITIALIZED
    End If
End Sub

Private Sub view_Activated()

    On Error GoTo CleanFail
    ThrowIfNotInitialized

    If Not this.instance Is Nothing Then
        ExecuteInstanceMethod
    Else
        ExecuteMacro
    End If

CleanExit:
    view.Hide
    Exit Sub

CleanFail:
    MsgBox Err.Number & vbTab & Err.Description, vbCritical, "Error"
    Resume CleanExit
End Sub

Private Sub ExecuteMacro()
    On Error GoTo CleanFail
    Application.Run this.procedure, Me

CleanExit:
    Exit Sub

CleanFail:
    If Err.Number = 438 Then
        Err.Raise ProgressIndicatorError.Error_ProcedureNotFound, TypeName(Me), ERR_PROC_NOT_FOUND
    Else
        Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
    Resume CleanExit
End Sub

Private Sub ExecuteInstanceMethod()
    On Error GoTo CleanFail

    Dim parameter As ProgressIndicator
    Set parameter = Me 'Me cannot be passed to CallByName directly

    CallByName this.instance, this.procedure, VbMethod, parameter

CleanExit:
    Exit Sub

CleanFail:
    If Err.Number = 438 Then
        Err.Raise ProgressIndicatorError.Error_ProcedureNotFound, TypeName(Me), ERR_PROC_NOT_FOUND
    Else
        Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
    Resume CleanExit
End Sub

Private Sub view_Cancelled()
    'this error isn't trappable, but not raising it wouldn't cancel anything:
    Err.Raise ProgressIndicatorError.Error_OperationCancelled, TypeName(Me), ERR_OPERATION_CANCELLED
End Sub

One thing I don't like, is that UpdatePercent will validate the percentValue parameter twice. Another thing I don't like, is that ValidatePercentValue has side-effects and should really be a Function that returns a Boolean... or it should have a different name, but I'm not sure what.

---

Client Code

The client code is in two parts; the first is responsible for instantiating the ProgressIndicator and specifying what procedure will do the work. Typically that would be a parameterless macro procedure attached to an ActiveX or Forms button on a worksheet:

Public Sub DoSomething()
    With ProgressIndicator.Create("DoWork")
        .Execute
    End With
End Sub

The "DoWork" procedure can be any Public Sub located in a standard or class module, taking a ProgressIndicator parameter - here it's a macro procedure in a standard module. I could have specified an instance parameter to make it work off a member procedure, too.

All that procedure needs to care about, is the work it's responsible for; when it needs to report progress, it can do so by calling the Update or UpdatePercent method on the progress parameter:

Public Sub DoWork(ByVal progress As ProgressIndicator)
    
    Dim i As Long
    For i = 1 To 1000
        Cells(1, 1) = i
        progress.UpdatePercent i / 1000
    Next
    
End Sub

Any oversight?

---

I'm using a Framework.Strings.Contains function in the ProgressIndicator class - as I said this code lives in an Excel add-in that has plenty of other useful tools; here's the function in question, for completeness:

Public Function Contains(ByVal string_source As String, ByVal find_text As String, Optional ByVal caseSensitive As Boolean = False) As Boolean
        
    Dim compareMethod As VbCompareMethod
    
    If caseSensitive Then
        compareMethod = vbBinaryCompare
    Else
        compareMethod = vbTextCompare
    End If
    
    Contains = (InStr(1, string_source, find_text, compareMethod) <> 0)
    
End Function

Answer 1

There are a number of (minor) issues here.

Re-raising errors

This is rather ugly:

Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext

Per MSDN, Err.Raise can "rethrow" an error much cleaner than that:

All of the Raise arguments except Number are optional. If you omit optional arguments, and the property settings of the Err object contain values that have not been cleared, those values serve as the values for your error.

This means the above can be shortened to, Err.Raise Err.Number.

---

Magic Constants

Other than the hard-coded error numbers mentioned in @Snowbody's answer...

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        Cancel = True
        RaiseEvent Cancelled
    End If
End Sub

...0 is a magic value in CloseMode = 0; the VBA standard library defines the vbQueryClose enum for that purpose - replacing value 0 with vbQueryClose.vbFormControlMenu makes it much clearer that the condition is evaluating whether the CloseMode is related to the user clicking the red "X" in the form's control box.

---

Cancellation

This is totally unacceptable UX - this error will bring up a VBA debugger window prompting the user to End execution or Debug the code... which makes it a feature that feels like a bug!

Private Sub view_Cancelled()
    'this error isn't trappable, but not raising it wouldn't cancel anything:
    Err.Raise ProgressIndicatorError.Error_OperationCancelled, TypeName(Me), ERR_OPERATION_CANCELLED
End Sub

Raising an untrappable error doesn't cancel the task in progress, it nukes it.

You have already cancelled the form's closing; all you need to do is to forbid the cancellation of the task in progress... unless the client code has an explicit way of handling cancellation - and you can let the client code know the user intends to cancel the task, by raising an event.

I would add a canCancel member to this, which would only be True when the "DoWork" code is located in a class module (i.e. when the ProgressIndicator instance can be a Private WithEvents field) - then you can leave it up to the client code to decide whether they want to nuke the long-running process, or handle it cleanly.

So you add a BeforeCancel event to the ProgressIndicator:

Public Event BeforeCancel(ByRef throw As Boolean)

And you raise it before the nuke goes off, to allow the client code to set throw to False and deal with cleanly cancelling the task:

Private Sub view_Cancelled()

    If Not this.canCancel Then Exit Sub

    Dim throw As Boolean
    throw = True
    RaiseEvent BeforeCancel(throw)

    'this error isn't trappable, but not raising it wouldn't cancel anything:
    If throw Then OnCancelledError

End Sub

Then the client code can have a Boolean flag to capture the cancelling state of the progress indicator:

Private WithEvents indicator As ProgressIndicator
Private isCancelling As Boolean

And deal with the BeforeCancel event like this:

Private Sub indicator_BeforeCancel(throw As Boolean)
    isCancelling = True
    throw = False
End Sub

Private Sub OnProgressCancelled()
    Err.Raise ProgressIndicatorError.Error_OperationCancelled, TypeName(Me), "Operation was cancelled."
End Sub

And now the "DoWork" code can periodically evaluate the isCancelling flag, and act accordingly:

For Each record In data

    If isCancelling Then OnProgressCancelled

    ...

...resulting in a clean cancellation:

Answer 2

Update percentValue, Format(percentValue, "0.0% Completed")

Maybe make the format string settable, in case the code is used in a different language, or one which uses a different character as the integer-fraction separator.

    percentValue = percentValue / 100

Isn't * .01 faster?

What's the magic number 438? It's there twice, can you make it a Const at least?

Seriously, this is very good code, that's the reason you're not getting much attention, there's not much to suggest!

Answer 3

Create an IProgress interface, and have your class implement the interface. Then the interface can be reimplemented by Access forms that do the same thing, or by classes that encapsulate the application's own status bar progress indicator, or any other class that wants to show progress using DrawRectangle, or the ribbon, or Excel cells, or Excel charts, or an InternetExplorer window, or ASCII art or whatever.

Then any routine that currently accepts a ProgressIndicator would change to accept any class that implements an IProgress interface.

The interface only exposes the properties and methods that make it usable, and the interface abstracts away any dependency on Excel.

Any class that consumes an IProgress can then run 'silently' without any problems, where IProgess won't actually implement progress.