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 belowProgress 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
P
ublic
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. |