Application.OnTime seems to conflict with manually started subs - vba

Question

I've made a workbook what has to be closed after 10 minutes of inactivity. I use a timer with Application.OnTime. I use the Application.OnTime command after every minute of inactivity, to refresh a message in the statusbar. In the last minute I use the Application.OnTime command after every second of inactivity to speed up the messages in the statusbar.
This works well, so far so good.
Public dtNextTime As Date
Public lngWaitTime As Long
Public lngRefreshTime As Long
Sub StartCountDownTimer()
Call StopCountDownTimer
dtNextTime = 0
lngWaitTime = 1 * 60 ' In my real workbook, the user can change the 10 minutes in a cell and I use this value in this sub
' Set initial RefreshTime
lngRefreshTime = 60
Call PlanNextTime
End Sub
Sub PlanNextTime()
Dim strWaitTime As String
Dim lngShowWaitTime As Long
If lngWaitTime >= 60 Then
lngShowWaitTime = lngWaitTime / 60
Else
lngShowWaitTime = lngWaitTime
End If
Select Case lngWaitTime
Case Is >= 120
strWaitTime = " minutes"
Case Is >= 60
strWaitTime = " minute"
Case Is > 1
strWaitTime = " seconds"
Case Is = 1
strWaitTime = " second"
End Select
Application.StatusBar = "If you don't use this workbook it will be closed in " & lngShowWaitTime & strWaitTime
If lngWaitTime <= 0 Then
Application.StatusBar = "Workbook is being closed"
Call CloseWorkbook
Else
If dtNextTime = 0 Then dtNextTime = Now()
If lngWaitTime > 60 Then
lngRefreshTime = 60
Else
lngRefreshTime = 1
End If
Application.OnTime EarliestTime:=dtNextTime, Procedure:="PlanNextTime", Schedule:=True
dtNextTime = dtNextTime + TimeSerial(0, 0, lngRefreshTime)
lngWaitTime = lngWaitTime - lngRefreshTime
End If
End Sub
Sub StopCountDownTimer()
On Error Resume Next
Application.OnTime EarliestTime:=dtNextTime, Procedure:="PlanNextTime", Schedule:=False
On Error GoTo 0
Application.StatusBar = False
End Sub
Sub CloseWorkbook()
' In my real workbook, at this place I call a sub to do some final things like saving the workbook
Application.StatusBar = False
ThisWorkbook.Close
End Sub
To test this, I used only the last minute. Then I found out I get strange problems with other manually started procedures. My preliminary conclusion: you can't run a manually started procedure together the a procedure started with the Application.OnTime command. I think I can find a workaround, but I want to be sure my conclusion is right. Excel VBA should be single-threaded, so I'm not sure my conclusion is right.
Therefore my question to you: is someone familiar with problems with procedures fired with the Application.OnTime command, fired on the same time a manual started procedure is running?
Do you know any way to deal with this issue?

Answer 1

I think your issue is that the Event you've created doesn't fire when an existing routine is running. That would be correct for the reason you surmised: Excel VBA is single-threaded.
Perhaps your 'manually started' procedure is amending records in a large table for instance or similar? If that's the case, insert a DoEvents into your loops to allow any pending events scheduled to be fired. This will cause the running to jump to your scheduled subroutine (PlanNextTime()) and complete that before returning to your loop.
I can't see much wrong with your posted code, though I confess I've not gone through it entirely to check your clever but confusing minutes vs seconds handling. I did notice however that you don't appear to be calling StopCountDownTimer() within your CloseWorkbook(). This will likely mean that on closing the workbook, or even Excel entirely, Excel will re-open the Workbook after closing to run your next scheduled event.