OnTime for less than 1 second without becoming Unresponsive
I have a userform which runs a script every 100ms. The script handles images on the userform and is used to animate them, while the form continues to receive user input (mouse clicks and key presses). This continues until the userform is closed. While Application.OnTime seems to work best, it only operates consistently on time values of 1 second or more.
When I use something like
Sub StartTimer()
Application.OnTime now + (TimeValue("00:00:01") / 10), "Timer"
End Sub
Private Sub Timer()
TheUserForm.ScreenUpdate
Application.OnTime now + (TimeValue("00:00:01") / 10), "Timer"
End Sub
and call StartTimer in the userform, Excel becomes very unresponsive and "Timer" is called many more times per second than it should.
Using the Sleep function causes the program to become unresponsive too, although the script is run with the right interval.
Is there a workaround for this? Thanks in advance!
OnTime
can only be scheduled to run in increments of 1 second. When you attempt to schedule it at 1/10th second, you actually schedule at 0 seconds, ie it runs again immediately, consuming all resources.
Short answer, you cannot use OnTime
to run an event every 1/10 second.
There are other ways, see CPearson for using a call to Windows APIPublic Declare Function SetTimer Lib "user32" ...
Try this simple hybrid method for your 'Timer' sub:
Sub Timer
Application.OnTime now + TimeValue("00:00:01"), "Timer"
t1 = Timer
Do Until Timer >= t1 + 0.9
t2 = Timer
Do Until Timer >= t2 + 0.1
DoEvents
Loop
TheUserForm.ScreenUpdate
... your code
Loop
End Sub
Of course, one problem of user the 'Timer' function is that at midnight your code may turn into a pumpkin (or crash). ;) You would need to make this smarter but if you generally only work during the day, like me, it's not a problem.
Just had this same question today. Here's the solution I was able to find that worked really well. It allows a timed event to fire on intervals as small as 1 millisecond, without taking control of the application or causing it to crash.
The one disadvantage I've been able to find is that TimerEvent()
requires a blanket On Error Resume Next
to ignore errors caused when it can't execute the code (like when you're editing another cell), which means it will have no idea when a legitimate error occurs.
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, _
ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, _
ByVal nIDEvent As LongPtr) As Long
Public TimerID As Long
Sub StartTimer()
' Run TimerEvent every 100/1000s of a second
TimerID = SetTimer(0, 0, 100, AddressOf TimerEvent)
End Sub
Sub StopTimer()
KillTimer 0, TimerID
End Sub
Sub TimerEvent()
On Error Resume Next
Cells(1, 1).Value = Cells(1, 1).Value + 1
End Sub