Countdown timer

Implementing an asynchronous timer for Excel Get it now

This article will show you how to implement a progress bar or countdown timer in VBA, and give you a downloadable example and reusable classes to get you started. 

This section is a full description of how to create a countdown timer class. 

If you just want to use a ready made one, then start here. 

A  complete countdown timer Procedure could be as simple as this using the provided classes and examples.
Option Explicit
Dim shpInner As Shape
Dim shpOuter As Shape
Dim ptimer As cProgressTimer
Sub shapeCountdownExecute()
    Set ptimer = New cProgressTimer
    createShapes
    With ptimer
        .init shpInner, "shapeUpdate", "shapeCountDownOutOfTime", 15
        .Start
    End With
End Sub

Implementation basics

This will be implemented as a custom class cProgressBar, and the example will also include a few modules to demonstrate its use, as well as some example timers, a selection of which are below

     
     

  Progress Bar or Countdown Timer

A progress bar will normally show how much has been so far processed for a particular synchronous task, such as process that copies data from one area to another. Conversely, a countdown timer will normally show how much time is left in which to achieve a particular task. The key difference is that there is normally a lot going on when a progress bar is in play, so it's rather easy to synchrounously take time out from a loop, calculate how much has been achieved and provide a regular visual update. When a countdown timer is in play, there is usually nothing going on.We would typically be waiting for user input or some other asynchronous event. This means that we cannot use the approach of reporting progress as part of a loop, since there is no loop. This article will show how to create a class that can be used both to show countdown and progress, and will also provide a downloadable example you can easily implement in your project and modify the code as you need. As usual you can download the complete package in the downloads section 

Testing and demonstration

In order to demonstrate these capablities, there are a number of shapes and forms set up in the downloadable project. You should try out the various examples to understand the capabilities we are about to go through.  If you just want to use a ready made one, then start here.

Let's start by looking at the general structure of a simple countdown timer, implemented on a form. This example is executed by the button "Show simple countdown timer" in the downloadable workbook.

A simple countdown timer

The first step is to create an instance of a the class, initialize, then start it. Also since this example is being implemented on a userform, you will need to create a userform with a label on it that will be used as the template for the timer. The minimum arguments required are shown here - the object that will be used to display the timer, the name of the procedure to call when an update is due, and the procedure to call when time is up. All the other arguments are optional and have a sensible default. Note: It is important that you create these in a regular Module (not a sheet or form module). This is because the class uses Application.Ontime to schedule update events, and these can only be called if they are in a regular module. 

dim pTimer as cProgressTimer
Sub simpleCountdownExecute()
' start the timer - called by activating the simple form
Set pTimer = New cProgressTimer
  With pTimer
   .init fSimpleCountdown.lbBar, "simpleUpdate", "simpleCountDownOutOfTime"
   .Start
  End With
End Sub


Next we will need the update procedure, which is called each time the timer is updated. In this case, we need do no special processing since the .Update method of the cProgressTimer class does all the necessary object updating, and also schedules the next update. You may of course do some other processing here if you wish. 

Public Sub simpleUpdate()
' this is an indirect call to a method because application.ontime cannot access within a class
If Not pTimer Is Nothing Then
  pTimer.Update
End If
End Sub


Finally we need to handle the case where the timer runs out of time. In this case, the example illustrates how to extend the time using the current timer with the use of the .RatioElapsed property. Setting this to 0.5 allows the same time again that has already passed, and .Restart starts the timer off again. The only mandatory process required here is to execute the .calloutExecuted method to indicate that the procedure has indeed been handled, and it should be followed by a .destroy to release up the resources if a .Restart is not required. 

Public Sub simpleCountDownOutOfTime()
' this is an indirect call for what to do when out of time
If Not pTimer Is Nothing Then
      With pTimer
' you must include this to mark that you have been called and have executed
       .calloutExecuted
' take some action for being out of time.. give it a bit longer and restart it
       If MsgBox("You have run out of time.. wait some more?", vbYesNo) = vbYes Then
             .ratioElapsed = 0.5
             .reStart
       Else
             pTimer.Destroy
            Set pTimer = Nothing
            Unload fSimpleCountdown
       End If
      End With
    End If
End Sub


Obviously in your project you will also be waiting for some event on the form to take place before the timer runs out. If it does, you will need to handle closing down the timer there. This should be done by .Destroy and setting the object to Nothing, just as in the out of time example. 

A simple progress Timer

The countdown timer was used to wait for some user input in the example above. In the case of the progress timer, we want to execute some long running process and show how it is progressing. We'll take a look at the example "Show simple progress bar" for how that is done.

As before we need to create a form with a label to be used as a template, then create, initialize and start an instance of cProgressTimer. In this case I have supplied a few extra of the optional arguments to .Init. The first True identifies that this is a progress timer rather than a countdown timer (meaning that the bar will expand rather than contract over time), and the second True indicates that I'd like to see a %age progress reported. The final given argument is an array of colors to override the defaults. The color of the bar will change as time passes according to the colors in your list. The default is array(vbGreen, vbYellow, vbRed). 

Since the progress timer is to report on how far along we are, you need to adjust .ratioElapsed from time to time. In this case, using the percentage of the total number of loops that have been executed so far. Note that this does not replot the timer. It simply fine tunes the estimate of how much longer there is to go by examining how much has been done in the time passed so far. The timer is updated asynchronously according to the interval specified as one of the initialization arguments (by default every second) and is independent of this synchronous activity.

Finally when processing is completed you need to handle wrapping up. .Flush will bring the timer up to date if we are between updates (essentially bringing it to 100%) , followed by destoying the timer and unloading the form.

Sub simpleProgressBarExecute()
    Dim i As Long
    Const nTestLoop = 5000000

' start the timer - called by activating the simple form
    Set pTimer = New cProgressTimer
    With pTimer
       .init fSimple.lbBar, "simpleUpdate", "simpleProgressOutOfTime", , True, , , , , True, , _
          Array(RGB(180, 23, 90), RGB(90, 23, 180))
       .Start
      End With

' do whatever processes we are timing
    For i = 1 To nTestLoop
       doSomethingComplicated
' if this happens then the form has been closed down in the middle of processing
       If pTimer Is Nothing Then Exit Sub
' update how much of the task is completed and bar will adjust itself on next update
       pTimer.ratioElapsed = CDbl(i) / nTestLoop
    Next i
' wrap up

    pTimer.Flush
    MsgBox "Completed task in " & Format(pTimer.timeElapsed, ".##") & " seconds"
    simplepTimerDestroy
    Unload fSimple
End Sub

As before, we need to create procedures to handle the update and out of time events. The update is the same as for the countdown timer, and the out of time just automatically extends the time. Remember that we automatically adjust the time every loop anyway using pTimer.ratioElapsed = CDbl(i) / nTestLoop.

Public Sub simpleProgressOutOfTime()
' this is an indirect call for what to do when out of time
    If Not pTimer Is Nothing Then
      With pTimer
' you must include this to mark that you have been called and have executed
           .calloutExecuted
' take some action for being out of time.. give it a bit longer and restart it
           .ratioElapsed = 0.9
           .reStart
      End With
    End If
End Sub

Seconds remaining, Elapsed and Pausing.

There are other capabilities that were required as part of the design. which have also been implemented and can be seen through the example 'Show complete test". The initialization for this is as follows, and takes many of the parameters from the Test Form so you can try out various options before implementing them in your project. 
With fProgressBar
    pTimer.init .lbContainer, _
    "progressUpdate", "progressOutOfTime", _
    .tbSeconds.Value, _
    .obReverseCountDown.Value, _
    .tbTimeRemaining, _
    .tbTimeElapsed, _
    .tbPause, .tbUpdateInterval.Value, _
    .obShowPercentage.Value, _
      "#", _
    Array(vbGreen, vbYellow, vbRed)

    pTimer.Start
End With


Init Method

Each cProgressBar needs to be initialized and it is this initialization process that defines the type of timer and its behavior. Below is the complete list of arguments along with their default values.

Public Sub init(formBar As Object, _
    procToCall As String, _
    procOutOfTime As String, _
    Optional timeTarget As Double = 30, _
    Optional aProgressBar As Boolean = False, _
    Optional countDownText As Object = Nothing, _
    Optional elapsedText As Object = Nothing, _
    Optional pauseToggle As MSForms.ToggleButton = Nothing, _
    Optional updateInterval As Double = 1, _
    Optional showPercentage As Boolean = False, _
    Optional secondFormat As String = "#", _
    Optional barColors As Variant = Empty, _
    Optional barVertical As Boolean = False, _
    Optional barCenter As Boolean = False)

' constructor for countdown - called once to set up options for progress bar
    Set pTimer = New cGeneralObject
    pTimer.init formBar, barVertical, barCenter ' the object to show progress
    
    pTimeEstimate = timeTarget ' estimated time of task
    pSize = pTimer.Size ' remember the original length of the label

    paProgressBar = aProgressBar ' whether to increase or decrease length to show progress
    pUpdateInterval = updateInterval ' how often to update
    pScheduledUpdateProcess = procToCall ' which provedure to call when time to update
    pActiveScheduled = "" ' which procedure is current scheduled
    pWhenOutofTime = procOutOfTime ' procedure to call when time is up
    Set pbutPause = pauseToggle ' optional toggle button to allow pausing
    pShowPercentage = showPercentage ' whether to chow percentage on progress bar
    psecondFormat = secondFormat ' format to use when showing time in textboxes

' these are the default colors for the count down bar
    If IsEmpty(barColors) Then
      pTimerColors = Array(vbGreen, vbYellow, vbRed)
    Else
      pTimerColors = barColors
    End If
    pOriginalFill = pTimer.Fill 
' we're going to need this for task scheduling to fully qualify application.
' otherwise multiple excel instances seem to be able to screw up the application. object
    Set pxlApp = GetObject(, "Excel.Application")
    If Not countDownText Is Nothing Then
      Set pCountDown = New cGeneralObject
      pCountDown.init countDownText
      pCountDown.Value = Format(pTimeEstimate, psecondFormat) ' initialize with initial task estimate
    End If

    If Not elapsedText Is Nothing Then
      Set pElapsed = New cGeneralObject
      pElapsed.init elapsedText
      pElapsed.Value = Format(0, psecondFormat) ' initialize with initial task estimate
    End If

End Sub


Using shapes instead of forms

In the examples so far, each of the template shapes has been implemented on a Userform. One of the design requirements was to be able to use any excel shape as a template. That would mean the ability to show a timer without a userform, and would also open up the possibility of circular or other more exotic timers. One of the problems with this is that form controls have entirely different properties than Excel shapes, so to keep the timer code as clean as possible, I have introduced another class, cGeneralObject. The objects that are designated as shape templates or progress report text are are all recast as this new type in the cProgressTimer class. This means that the vagaries of the particular object types and so can be hidden from the progress timer, and new objects can be implemented later without having to change it. The only exception is the Pause button, which if present, is expected to be a toggleButton Control. 

Here is an example of using an Oval shape on a worksheet as a timer template. In this case the Oval is actually a circle, and when i created it I have set its properties to "lock aspect ratio" to True, so that when it changes size it will shrink in both height and width. The "True" in the .Init method below indicates that the timer should resize around its center rather than from the top left.

Sub ovalshapeCountdownExecute()
     Set pTimer = New cProgressTimer
     With pTimer
          .init Sheets("Sheet1").Shapes("Oval 1"), "shapeUpdate", _
              "shapeCountDownOutOfTime", 20, , , , , , , , , , True
          .Start
     End With
End Sub


I also recommend creating a slightly larger, contrasting shape behind the timer template shape. As the timer shrinks (or expands), the background shape shows the size it is to grow to. Another interesting technique demonstrated in the example workbook is the uncovering of a picture as the timer reduces in size.

cGeneralObject class

You will find this class in the downloadable workbook. It has an .init method as follows, and takes the object to be recast as its first argument, Optionally you can specify whether it needs to be resized vertically (as opposed to the default horizontally), and whether it should be resized around its center (as opposed to being anchored with top and left properties)

Public Sub init(o As Object, Optional bVertical As Boolean = False, _
  Optional bCenter As Boolean = False)
    Set pObject = o
    pVertical = bVertical
    pCenter = bCenter
End Sub


The properties of interest are as follows, and allow the harmonization of access to properties when objects are of different types.

Public Property Get isaShape() As Boolean
Public Property Get Object() As Object
Public Property Get Size() As Double
Public Property Get Height() As Double
Public Property Get Width() As Double
Public Property Get Value() As String
Public Property Get Fill() As Long
Public Property Get Visible() As Boolean
Public Property Get gTypeName() As String
Public Property Get toShape() As Shape
Public Property Get toControl() As Control
Public Property Get toLabel() As MSForms.Label
Public Property Get toTextBox() As MSForms.TextBox


An example of one of these properties is given below and demonstrates how the calling procedure can use .Value regardless of the underlying object property structure.

Public Property Get Value() As String
If isaShape Then
  Value = toShape.TextFrame.Characters.Text
ElseIf gTypeName = "Label" Then
  Value = toLabel.Caption
Else
  Value = pObject.Value
End If
End Property


The use of Application.Ontime
Since this is an approach to showing progress that relies on scheduled events rather than processing events, it makes use of Application.Ontime. This allows you to schedule the running of a procedure at some stated time in the future. Since it is an application level method, it can continue even after your form has been closed or even your sheet has been closed. Care must be taken then to ensure that all requests are cancelled when the timing activity is over. Earlier we dealt with ensuring that the outOfTime and the Update events were handled correctly. This is the code implemented in the cProgressTimer class that schedules and cancels updates.

Private Sub cancelScheduledUpdate()
'cancel any scheduled updates
    If pNextUpdate <> 0 Then

      pxlApp.Application.OnTime pNextUpdate, pActiveScheduled, , False
      pNextUpdate = 0

    End If

End Sub

Private Sub scheduleUpdate()

' in case there are any outstanding - we only need one
    cancelScheduledUpdate

    If isOutOfTime Then
      If pActiveScheduled = pWhenOutofTime Then
       MsgBox ("Programming Error - Out of time call to " & pActiveScheduled & " was already scheduled     but not executed")
       pActiveScheduled = ""
      Else
       pActiveScheduled = pWhenOutofTime
      End If
    Else
      pActiveScheduled = pScheduledUpdateProcess
    End If

    If pActiveScheduled <> "" Then
      pNextUpdate = Now + TimeSerial(0, 0, pUpdateInterval)
      pxlApp.Application.OnTime pNextUpdate, pActiveScheduled

    End If

End Sub

It is worth mentioning a couple of things about application.Ontime, which is really rather picky
  • If you cancel a scheduled event you have to know the exact time it was scheduled for, as well as the name of procedure that was to run. That is why you should never use Now + timeserial(..) as an argument to application.Ontime (since Now will change when you try to call it again), but rather store the target time separately, then use the result as an argument. 
  • You should never use on Error Resume Next when dealing with Application.Ontime (or anywhere else for that matter), since you really need it to fall over on a problem otherwise you risk the spreadsheet just bombing out of control. 
  • The application object is one of those objects that does not need to be fully qualifed. Normally Application.Ontime should do just fine. However, if you have multiple instances of Excel running, it sometimes forgets what object Application is. To avoid this it is worth specifically identifying the Excel Object at initializing time , Set pxlApp = GetObject(, "Excel.Application") , and fully qualifying the application object, pxlApp.Application.OnTime pNextUpdate, pActiveScheduled
  • Application.Ontime calls a procedure you name. This procedure has to be a public procedure in a regular Module. It cant's be in a class module, a worksheet module or a form module. This means that you need to provide an update procedure that calls the class back in order to do the update work. The benefit of this is that it does allow for some additional, customized processing at update time if that is required. 

DoEvents and .ratioElapsed

Doevents is something that needs to be called from time to time in order to update shapes and also to execute the application.Ontime queue. When there is a lot of processing going on as is normally the case for a progress bar, you wont see progress shown unless doEvents is executed. The problem is that you dont want to execute it a lot, since it is rather resource hungry. This is where a timer based progress bar really comes in to its own compared to one that is updated as part of a loop, but on the other hand it presents a complex problem. The only time that doEvents needs to be called really is when there is something to report. But as mentioned before, the scheduled event that you would expect to call doEvents (ie the Update process), won't actually be called if the processor is tied up. The solution lies in the ratioElapsed property. Since .ratioElapsed is updated during a processing loop as in this example, pTimer.ratioElapsed = CDbl(i) / nTestLoop, we can check to see if any update is past due, and if so flush it out with a doEvents. This minimizes the number of times that doEvents is called, yet ensures that updates are made regularly.

Public Property Let ratioElapsed(ratioTaskComplete As Double)
' need to reset the timeallowe dmid flight
' note this actually updates the TimeEstimate property
    If ratioTaskComplete < 1 And ratioTaskComplete > 0 Then
      pTimeEstimate = timeElapsed / ratioTaskComplete
      eventsFlush
    End If
End Property
Public Sub eventsFlush()
' when not idle, the appilcation on time event is not serviced
' if there is an outstanding scheduled event this will generate a doevents
' using this minimizes the use of doEvents to only when they are essential
    If pNextUpdate <> 0 Then
      If pNextUpdate < Now Then
                   DoEvents
      End If
    End If
End Sub


Properties and methods of interest in cProgressTimer

Public Sub init(formBar As Object, _
procToCall As String, _
procOutOfTime As String, _
Optional timeTarget As Double = 30, _
Optional aProgressBar As Boolean = False, _
Optional countDownText As Object = Nothing, _
Optional elapsedText As Object = Nothing, _
Optional pauseToggle As MSForms.ToggleButton = Nothing, _
Optional updateInterval As Double = 1, _
Optional showPercentage As Boolean = False, _
Optional secondFormat As String = "#", _
Optional barColors As Variant = Empty, _
Optional barVertical As Boolean = False, _
Optional barCenter As Boolean = False)
Public Sub Update()
Public Sub Start()
Public Sub reStart()
Public Sub calloutExecuted()
Public Sub Pause()
Public Sub Destroy()
Public Sub Flush()
Public Sub eventsFlush()
Public Property Get isOutOfTime() As Boolean
Public Property Get ratioElapsed() As Double
Public Property Get timeElapsed() As Double


Implementing form and other events

As mentioned previously, the procedures called by application.ontime have to be in a regular module. It is better then to minimize the code in form or sheet modules that handle related events. Here is the code implemented for the events associated with the "show full test" example. You can see that they are simply stub event catchers that are implemented in the main handler module. One thing to note is that you should certainly implement a userform_terminate() handler that destroys the timer to ensure that any outstanding Application.Ontime scheduled events are cancelled. 
Option Explicit
Private Sub cbLaunch_Click()
     pTimerLaunch
End Sub

 Private Sub tbPause_Click()
     pTimerPause
End Sub

 Private Sub tbRatioComplete_Exit(ByVal Cancel As MSForms.ReturnBoolean)
     pTimerChangeRatioComplete
End Sub

 Private Sub UserForm_Activate()
     pTimerActivate
End Sub

 Private Sub UserForm_Terminate()
     pTimerDestroy
End Sub

Implementation details 

Show Progress of a task against an estimated time

 A template object size is changed as time passes
Modify the estimated time if necessary during the process

 The eventual estimated time can be reset at any time either directly or by resetting the %age of the task that is complete.
Provide asynchronous progress updates

 The bar is updated regularly according to a specified interval
Generate an event when a bar update is ready to occur

 The procedure specified is called every time the bar is ready to be updated
Generate an event when the task has exceeded the estimated time

 The procedure specified is called when time is up
Allow the bar to either extend (progress bar) or reduce (countdown timer)

 The resizing characteristics can be selected by a parameter
Optionally show percentage complete

 Whether to show percentage complete is selected by a parameter
Optionally show time elapsed

 If elapsed time is needed it will be shown in a template object specified as an optional parameter
Optionally show time remaining

 If time remaining is needed it will be shown in a template object specified as an optional parameter
Optionally provide a means of pausing the timer 

 If this is required a toggle button will be used to start and stop the timer. When paused, any time that passes will not be counted
Change color of progress bar depending on how much time is left

 By default the bar will change color as there is less time left. These colors and behaviors can be modified by the use of an optional list of colors to use.
The class should be able to use any excel shape.

 Any excel shape can be used as the basis for the timer. If a shape such as an oval is used, the shape's lock aspect ratio should be set if it is expected to shrink (or grow) proportionally. An option is also available to keep the item centered as it changes size.
Vertical (thermometer style) progress is required as an option An optional parameter specifies whether height or width is adjusted to show progress.

Summary

Now that this we have created a framework for a countdown timer, we will go ahead and implement this in the Sudoku project. This article was previously published in Egghead Cafe. Acknowledgement for the original version of the microtimer procedure to Charles Williams, Decision Models Limited