I don’t speak English, so I’m using ChatGPT to help translate my question.
I’m using Microsoft 365 Excel.
I'm trying to schedule a recurring process using Application.OnTime, but it doesn't start at the exact scheduled time. Here is the code where the issue occurs:
Option Explicit
Private Count As Long
Sub Start()
Count = 1
Application.OnTime DateAdd("s", 2, Time), "Routine"
End Sub
Sub Routine()
Dim tm
tm = Time
Debug.Print "Count:" & Count & " now:" & tm
ThisWorkbook.Worksheets(1).Cells(1, 1) = Count
tm = DateAdd("s", 1, tm)
Application.OnTime tm, "Routine"
Count = Count + 1
Debug.Print " next:" & tm
Debug.Print "----------------------------"
End Sub
This code updates cell A1 every second and prints the count and current time to the Immediate Window. I run Start() and then leave Excel alone—no mouse or keyboard input.
Then, starting from Count = 11, the routine begins 4 seconds late. From Count = 20, it begins 19 seconds late.
Here’s part of the Immediate Window output:
Count:1 now:5:27:42
next:5:27:43
----------------------------
Count:2 now:5:27:43
next:5:27:44
----------------------------
...
Count:9 now:5:27:50
next:5:27:51
----------------------------
Count:10 now:5:27:55 ← 4-second delay began
next:5:27:56
----------------------------
...
Count:19 now:5:28:40
next:5:28:41
----------------------------
Count:20 now:5:29:00 ← 19-second delay began
next:5:29:01
----------------------------
...
When I perform any action that changes Excel's state—such as moving the active cell or switching the window focus—the delay disappears.
For example:
I tested this behavior on four different PCs:
I expected Application.OnTime to trigger the scheduled procedure precisely every second, regardless of user interaction. However, it seems to depend on whether Excel is "active" in some way.
Is this behavior specific to certain environments or versions of Windows?
This delay is a problem because I need to execute code precisely every second.
If anyone knows a workaround or solution, I would greatly appreciate your help.
PS: Additional information:
I do not need millisecond-level precision. I’m aware that Application.OnTime is not meant for high-precision scheduling.
However, I’ve tried several suggestions with the help of ChatGPT, including running diagnostics and even performing an in-place Windows upgrade, but unfortunately the problem still remains.
I’ve been using Application.OnTime for years on Windows 10 to perform tasks nearly every second, and I’ve never experienced this kind of delay before.
What I’m seeing is that starting from Count = 10 to Count = 19, the routine always starts approximately 4 seconds late each time.
Then from Count = 20, it suddenly starts 19 seconds late, and that longer delay continues indefinitely.
This is not a random glitch — once the delay starts, it becomes a persistent pattern.
After the delay starts, performing any mouse or keyboard action that changes Excel's state causes it to behave correctly again.
Additionally, I’ve confirmed that this same behavior occurs on multiple Windows 11 machines, which makes me suspect it’s related to how Excel behaves in the background or in idle state on Windows 11.
Rather than using Application.OnTime I would recommend switching to a timer with a triggered event every second. This should be a more robust method for avoiding a delay during operation.
It's a lot of additional code but Application.OnTime just schedules a function to run at the next available opportunity after the specified time has passed, not to run at that exact time.
General code for using a timer is below:
Private Declare Function SetTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Private Declare Function KillTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long 'Need a timer ID to turn off the timer. If the timer ID <> 0 then the timer is running
Public Sub ActivateTimer(ByVal Seconds As Long) 'The SetTimer call accepts milliseconds
On Error Resume Next
If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer
If TimerID = 0 Then TimerID = SetTimer(0, 0, Seconds * 1000, AddressOf TriggerEvent)
End Sub
Public Sub DeactivateTimer()
On Error Resume Next
Dim Success As Long: Success = KillTimer(0, TimerID)
If Success <> 0 Then TimerID = 0
End Sub
Public Sub TriggerEvent(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
Call EventFunction
End Sub
Public Function EventFunction()
' Code to run
End Function
Or for all VBA versions and including the count code:
Private Count As Long
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If
#If VBA7 Then
'TimerIDs to turn off timers. If a TimerID <> 0 then the timer is running
Public TimerID As LongPtr
Public Function StartTimer()
On Error Resume Next
Call ActivateTimer(1, AddressOf TriggerEvent, TimerID)
End Function
Public Sub TriggerEvent(ByVal hWnd As LongPtr, ByVal uMsg As LongPtr, ByVal idevent As LongPtr, ByVal Systime As LongPtr)
On Error Resume Next
Call EventFunction
End Sub
Private Function ActivateTimer(ByVal Seconds As Long, FunctionAddress As LongLong, ByRef TimerID As LongPtr) 'The SetTimer call accepts milliseconds
On Error Resume Next
If TimerID = 0 Then TimerID = SetTimer(0, 0, Seconds * 1000, FunctionAddress) 'Check to see if timer is running before call to SetTimer
End Function
Private Function DeactivateTimer(ByRef TimerID As LongLong)
On Error Resume Next
If KillTimer(0&, TimerID) <> 0 Then TimerID = 0
End Function
#Else
'TimerIDs to turn off timers. If a TimerID <> 0 then the timer is running
Public TimerID As Long
Public Function StartTimer()
On Error Resume Next
Call ActivateTimer(1, AddressOf TriggerEvent, TimerID)
End Function
Public Sub TriggerEvent(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
Call EventFunction
End Sub
Private Function ActivateTimer(ByVal Seconds As Long, FunctionAddress As Long, ByRef TimerID As Long) 'The SetTimer call accepts milliseconds
On Error Resume Next
If TimerID = 0 Then TimerID = SetTimer(0, 0, Seconds * 1000, FunctionAddress) 'Check to see if timer is running before call to SetTimer
End Function
Private Function DeactivateTimer(ByRef TimerID As Long)
On Error Resume Next
If KillTimer(0, TimerID) <> 0 Then TimerID = 0
End Function
#End If
Sub StartCount()
Count = 1
Call ActivateTimer(1, AddressOf TriggerEvent, TimerID)
End Sub
Sub StopCount()
Call DeactivateTimer(TimerID)
End Sub
Private Function EventFunction()
Dim tm: tm = Time
Debug.Print "Count:" & Count & " now:" & tm
ThisWorkbook.Worksheets(1).Cells(1, 1) = Count
Count = Count + 1
Debug.Print " next:" & DateAdd("s", 1, tm)
Debug.Print "----------------------------"
End Function