What can you learn here?

  • Timers
  • Scheduling tasks
  • Progress bars

Dealing with asynchronous events

VBA has Event Processing capabilities. This is how it is able to deal with mouse clicks, form events and so on. However this section is not about handling these kind of events that are triggered by ‘something happening’, but rather ‘time passing’. These concepts are implemented as progress bar and countdown timer class in this project. You can download the finished project and include it in your own projects if you need a ready built, asynchronous timer. 

Application Ontime

The Excel Application provides the OnTime method as a way to schedule future events. It is rather straightforward but also picky. Here is a small program that will stop every 5 seconds to see if you want to do more. Note it will run forever.  Option ExplicitDim pNextUpdate As DateConst pUpdateInterval = 5Sub testTimer()    scheduleAnother    While True        DoEvents    WendEnd SubSub scheduleAnother()    pNextUpdate = Now + TimeSerial(0, 0, pUpdateInterval)    Application.OnTime pNextUpdate, "popup"End SubSub popup()    If MsgBox("again?", vbYesNo) = vbYes Then scheduleAnotherEnd Sub Application.Ontime’s first 2 arguments are – the time it should run, followed by the name of the procedure to run (which needs to be in the scope of the procedure initiating the .Ontime method. 


Our main procedure does nothing but loop endlessly. In this kind of heavy compute intensive environment, Excel does not service events, so it means that the event we scheduled never gets a chance to get focus. The DoEvents command tells Excel to go have a look to see if there are any events that need to be handled. 

Stopping when done

Let’s modify our example a little so that it stops running when instructed to do so. The pNextUpdate variable will be 0 if instructed to stop. Otherwise it will be the time the next msgBox is due to be displayed. Note also it’s scope – it has to have visibility across the whole module since it will be accessed in multiple procedures.  Option ExplicitDim pNextUpdate As DateConst pUpdateInterval = 5Sub testTimer()    scheduleAnother    While pNextUpdate > 0        DoEvents    Wend    MsgBox ("all done")End SubSub scheduleAnother()    pNextUpdate = Now + TimeSerial(0, 0, pUpdateInterval)    Application.OnTime pNextUpdate, "popup"End SubSub popup()    pNextUpdate = 0    If MsgBox("again?", vbYesNo) = vbYes Then scheduleAnotherEnd Sub 

Making a countdown timer

There is a comprehensive countdown time class you can use implemented as part of this project. However you can see from this that we have the means to now create a report on some activity every ‘x’ seconds, which is essentially all that a countdown timer is. 

Here is a very simple implementation using the cProgressBar class, that will create a couple of shapes on the current worksheet and countdown graphically every second for 15 seconds, using them till it runs out of time, and looks like this.

 To implement this on a form instead, you can replace the shape with a label control on your form. You will need the cProgressBar class and the cGeneralObject class which are in the Gettingstartedseries workbook. If you are planning to use the createShapes procedure used in this example, you will also need the deviceAPI module – again, in the gettingStartedSeries workbook.  Option ExplicitDim shpInner As ShapeDim shpOuter As ShapeDim ptimer As cProgressTimerSub shapeCountdownExecute()    Set ptimer = New cProgressTimer    createShapes    With ptimer        .init shpInner, "shapeUpdate", "shapeCountDownOutOfTime", 15        .Start    End With    MsgBox ("all set up")End Sub Sub shapepTimerDestroy()    TimerDestroy ptimerEnd Sub  

Public Sub shapeUpdate()
' 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 IfEnd Sub Public Sub shapeCountDownOutOfTime()    outofTime ptimerEnd SubPublic Sub outofTime(pt As cProgressTimer)     If Not pt Is Nothing Then        With pt            ' 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.9                .reStart            Else               TimerDestroy pt             End If        End With    End IfEnd Sub Sub TimerDestroy(pt As cProgressTimer)    If Not pt Is Nothing Then        pt.Destroy        Set pt = Nothing    End If

End Sub

 Sub createShapes()    Dim shp As Shape, i As Long     ' create a couple of shapes    With ActiveSheet    ' delete any existing        For i = .Shapes.Count To 1 Step -1            .Shapes(i).Delete        Next i        Set shpOuter = .Shapes.AddShape(msoShapeRectangle, 10, 20, 100, 20)    End With    With shpOuter        .Line.Weight = 4        Set shpInner = ActiveSheet.Shapes.AddShape(.Type, _                .left + .Line.Weight * PixelstoPoints.left, _                .top + .Line.Weight * PixelstoPoints.top, _                .Width - .Line.Weight * PixelstoPoints.left * 2, _                .Height - .Line.Weight * PixelstoPoints.top * 2)    End With    With shpInner        'change to some random color        .Fill.ForeColor.SchemeColor = Int(Rnd() * 56)        .Line.Weight = 0     End With End Sub 

Create a progress Bar

The only real difference between a countdown timer and a progress bar is that one counts down (showing time left), and the other counts up (showing progress against predicted time). Implementing a progress bar is very similar to the countdown timer above. In fact the only change required is to tell the .init method you want a progress bar instead of a countdown timer — the ‘true’ in the call below  Sub shapeProgressBarExecute()    Set ptimer = New cProgressTimer    createShapes    With ptimer        .init shpInner, "shapeUpdate", "shapeCountDownOutOfTime", , True        .Start    End With    MsgBox ("all set up")End Sub However, since a progress bar is supposed to be measuring and predicting progress, we’d better actually do some work and measure it. 

Here is a typical Progress bar Implementation. In this case, I also used a parameter in .Init to indicate that I wanted to show %age completed on the bar.  The bar will look like this.

  Sub shapeProgressBarExecute()    Dim i As Long    Const cLoop = 1000000    Set ptimer = New cProgressTimer    createShapes    With ptimer        .init shpInner, "shapeUpdate", "shapeCountDownOutOfTime", , True, , , , , True        .Start    End With    '    ' do something lots of times    For i = 1 To cLoop        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) / cLoop    Next i    ' wrap up     ptimer.Flush    Application.Wait 1    MsgBox "Completed task in " & Format(ptimer.timeElapsed, ".##") & " seconds"    shapepTimerDestroyEnd Sub The only thing you have to do here, is to communicate how much of the task is completed at opportune processing points, though use of the .ratioElapsed property. The Progress bar is only actually replotted according to the interval you specify (1 sec default). You can see that in the example above, if done synchronously, the bar would have been replot 1 million times, instead of 30 times. Note that you don’t need to worry about DoEvents. When you update the .ratioElapsed property, it will take care of it if necessary. 

For more stuff see my book – Going Gas.  


Although it is not as rich as other languages in dealing with asynchronous events, VBA does have enough capabilities to cover what you are likely to need in scheduling and timing. The example above can be downloaded in the Getting Started Series Workbook, and you can take a look at some more advanced progress bars and countdown timer implementations (using the same classes discussed above) here. Other examples of timing capabilities can be found here. As usual, questions and feedback are welcomed.