Excel VBA Application.OnTime - Two Subs - more concise code

Question

I am trying to schedule two separate subs to run in Excel VBA using Application OnTime. I have managed to make it work using the code below - AA runs every 2 seconds and BB runs ever 5 seconds. Although it works, it feels a bit clunky to me with 6 different subs. Can anyone suggest ways to make it more concise?

Thanks.

Dim TimeToRun
Dim TimeToRunBB

Sub Start()
    Call Schedule
    Call ScheduleBB
End Sub

Sub Schedule()
    TimeToRun = Now + TimeValue("00:00:02")
    Application.OnTime TimeToRun, "AA"
End Sub

Sub ScheduleBB()
    TimeToRunBB = Now + TimeValue("00:00:05")
    Application.OnTime TimeToRunBB, "BB"
End Sub

Sub AA()
    Range("A1").Value = Rnd
    Call Schedule
End Sub

Sub BB()
    Range("A2").Value = Rnd
    Call ScheduleBB
End Sub

Sub StopIt()
    Application.OnTime TimeToRun, "AA", , False
    Application.OnTime TimeToRunBB, "BB", , False
End Sub

Answer 1

You could parameterize the scheduler procedure:

Private Sub ScheduleExecution(ByVal procedureName As String, ByVal executionTime As Date)
    Application.OnTime executionTime, procedureName
End Sub

But then, you've essentially abstracted the Application.OnTime method behind a procedure, without gaining anything out of it.

Might as well inline it.

Public Sub Start()
    Application.OnTime Now + TimeValue("00:00:02"), "AA"
    Application.OnTime Now + TimeValue("00:00:05"), "BB"
End Sub

What's redundant is the Now + TimeValue(secondsDelay) part. That's function-worthy.

Private Function ToTimeDelay(ByVal hhmmss As String) As Date
    ToTimeDelay = Now + TimeValue(hhmmss)
End Function

Now the Start procedure no longer needs to care about the reference date/time, only the offset:

Public Sub Start()
    Application.OnTime ToTimeDelay("00:00:02"), "AA"
    Application.OnTime ToTimeDelay("00:00:05"), "BB"
End Sub

The idea of having small procedures that do one thing and do it well, isn't clunky at all. It's a fundamental building block of SOLID (OOP) code: the Single Responsibility Principle: procedures should only do one thing. Notice how the Application.OnTime procedure isn't responsible for anything other than scheduling the execution of a macro.

What you're missing, to clean this up, is proper data structures. You want to map a procedure to a delay, and be able to retrieve both the procedure and its associated delay from some data structure. In VBA the data structure to use for any map, is a Dictionary.

Reference the Microsoft Scripting Runtime type library. Then you can do this:

Private Property Get ExecutionMap() As Dictionary
    Static map As Dictionary
    If map Is Nothing Then
        Set map = New Dictionary
        map.Add "AA", "00:00:02"
        map.Add "BB", "00:00:05"
    End If
    Set ExecutionMap = map
End Property

Now you can just iterate the dictionary keys to schedule all the mapped procedures, and you can maintain the map.Add statements to add, remove, or modify what runs when: the Start procedure is no longer concerned about what & when - its only job is to schedule all the procedures that need to be scheduled, whatever they are:

Public Sub Start()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
    Next
End Sub

And now each procedure can re-schedule itself by pulling the appropriate key:

Public Sub AA()
    Const procName As String = "AA"
    ActiveSheet.Range("A1").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

Public Sub BB()
    Const procName As String = "BB"
    ActiveSheet.Range("A2").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

And Stop can, similar to Start, simply iterate the keys again:

Public Sub Stop()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName, , False
    Next
End Sub

So to recap, that leaves us with a module like this:

Option Explicit

Private Property Get ExecutionMap() As Dictionary
    Static map As Dictionary
    If map Is Nothing Then
        Set map = New Dictionary
        map.Add "AA", "00:00:02"
        map.Add "BB", "00:00:05"
    End If
    Set ExecutionMap = map
End Property

Private Function ToTimeDelay(ByVal hhmmss As String) As Date
    ToTimeDelay = Now + TimeValue(hhmmss)
End Function

Public Sub Start()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
    Next
End Sub

Public Sub Stop()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName, , False
    Next
End Sub

Public Sub AA()
    Const procName As String = "AA"
    ActiveSheet.Range("A1").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

Public Sub BB()
    Const procName As String = "BB"
    ActiveSheet.Range("A2").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

The module-level variables are gone, maintaining the list of procedures to run and their respective delay is now in one place... but that's hardly more "concise".

If the list of procedures isn't going to grow, then there's no need to do this IMO. On the other hand if the list of procedures is going to need to change every week and adding it to Start and Stop every time gets annoyingly repetitive, then yeah then you consider upping the abstraction level and pulling that list into a Dictionary.

Otherwise, I'd just remove the Call statements, rename the procedures to more meaningful names, call it a day, and move on ;-)