Calling sub not completing before loop moves to next iteration in VBA

Question

I am writing a piece of VBA code to display a countdown timer. Excel Sheet 1 lists times and descriptions of the events and sheet 2 displays the countdown.

The idea is once the first event has successfully counted down, it checks the date of the second event, and if it is today it proceeds to count down to the second event and so on. The countdown aspect works successfully for the first time and description, but when it finishes counting down to the first event it stops altogether.

There are 3 subs, the first works out if the event is today and how long it needs to count down for. The first calls the second which does the counting down by subtracting a TimeSerial(0,0,1) and the third is a timer. I will admit I borrowed the 2nd and 3rd from a nicely written piece I found online (credit to whoever wrote that, thanks).

I have simplified what I have written below:

For i=1 to 10
    If *Conditions to determine if countdown should happen exist*
    *calculate time to countdown and sets it to sheets("Countdown").Cells("A13")*
       Cells(13, 1) = TotaltimeCountdown
       Call Countdowntimer
    End if
 Next i

Sub Countdowntimer()
    Sheets("Countdown").Activate
    Dim Counter As Range        
    Set Counter = ActiveSheet.Range("A13")

    If Counter.Value > 0 Then
        Counter.Value = Counter.Value - TimeSerial(0, 0, 1)
        Call Timer
    ElseIf Counter.Value <= 0 Then
        Sheets("Countdown").Range("A13:H17").ClearContents
        Exit Sub
    End If              
End Sub

'Sub to trigger the reset of the countdown timer every second
Sub Timer()
    Dim gCount As Date
    gCount = Now + TimeValue("00:00:01")
    Application.OnTime gCount, "Countdowntimer"
End Sub

I put a message box after calling Countdowntimer in the first sub and was able to establish that it displayed the amount of time to count down, then displayed the messagebox and cycled through each value of i. Only THEN did it actually proceed with the countdown.

Any suggestions on how to make the for loop pause completely until the countdown from the called sub is finished?

Any suggestions appreciated

Answer 1

The issue is using Application.OnTime and for a count down timer use a Do loop with DoEvents to count down.

Something like that:

Option Explicit

Public Sub CountDownTimer()
    With ThisWorkbook.Worksheets("Countdown")
        Dim Duration As Long
        Duration = 10 ' needs to be in seconds!
        'if your cell has a real datetime then use
        Duration = .Range("A13").Value * 24 * 60 * 60

        Dim TimerStart As Double
        TimerStart = Timer()

        Do While Timer <= TimerStart + Duration
            .Range("A13").Value = TimeSerial(0, 0, TimerStart + Duration - Timer)
            DoEvents
        Loop

        ThisWorkbook.Worksheets("Countdown").Range("A13:H17").ClearContents
    End With
End Sub