VBA - Difficulty interrupting Application.OnTime - vba

I am having difficult interrupting a looped Application.OnTime command. I have a macro I want to periodically loop every 5 seconds (CommandButton221), but then I want to be able to cut the loop off by pressing StopButton.
Private Sub CommandButton221_Click()
If StopMacro = True Then Exit Sub
'[Code that I want looping, not relevant to the question]
testup1
End Sub
Public Sub testup1()
RunWhen = Now + TimeValue("00:00:05")
Application.OnTime RunWhen, "CommandButton221_Click", , True
End Sub
Public Sub StopButton_Click()
StopMacro = True
End Sub
Any suggestions as how to achieve this would be hugely appreciated!

This should do it, a slightly different method, removing the schedule entirely when hitting the Stop button:
Public RunWhen As Double
Private Sub CommandButton221_Click()
Application.StatusBar = Now()
testup1
End Sub
Public Sub testup1()
RunWhen = Now + TimeValue("00:00:05")
Application.OnTime RunWhen, "CommandButton221_Click", , True
End Sub
Public Sub StopButton_Click()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="CommandButton221_Click", Schedule:=False
End Sub
Make sure the code you have in 221 doesn't take more than 5 seconds to run!

Try using the command DoEvents at the end of testup1() to yield control back to the O.S., which should allow the stop button event to occur. It is very easy for VBA to get stuck in loops with timers and/or heavy data processing and ignore other events.

Related

Looping an OnTime Event Crashes the Excel

Here's what I've put in my module:
Public Times As Boolean
Sub start()
Times = True
Track:
Application.OnTime Now() + TimeValue("00:00:01"), "Run"
If Times = True Then GoTo Track
End Sub
Sub run()
Range("E3").Value = Range("E3").Value + TimeValue("00:00:01")
End Sub
Sub Tend()
Times = False
End Sub
Now, when I run Start(), My Excel crashes.
Kindly Advice
Your code in Start is a tight loop which is not what you want to do I think.
Public Times As Boolean
Sub start()
Times = True
Run
End Sub
Sub run()
If Not Times Then Exit Sub
Application.OnTime Now() + TimeValue("00:00:01"), "Run"
Range("E3").Value = Range("E3").Value + TimeValue("00:00:01")
End Sub
Sub Tend()
Times = False
End Sub

vba start stop timers?

I want to start and stop two timers in my excel worksheet. This is what i have:
When worksheet is opened, this module is triggered:
Sub SetOpenTimer()
OpenTimer = Now + TimeValue("00:00:10")
Application.OnTime OpenTimer, "StartTimerShutdownForm"
End Sub
After 10 seconds (in this example), the sub startimershutdownform is triggered:
Sub StartTimerShutdownForm()
UserForm1.Show
End Sub
This displays a userform where a message is displayed. In the initialize sub in the Userform a sub setformtimer is triggered:
Sub setFormTimer()
FormTimer = Now + TimeValue("00:00:10")
Application.OnTime FormTimer, "Shutdown"
End Sub
If this timer in setformtimer ends, the sub shutdown is triggerd
this sub closes the workbook, but in the Userform there is a button for the user to cancel the setformtimer:
Sub stopFormTimer()
Application.OnTime EarliestTime:=FormTimer, _
Procedure:="setOpenTimer", Schedule:=False
End Sub
This suppose to stop the setformtimer, but it does not work.
When this timer is stopped, it suppose to restart the timer that is triggered when the document is being opened, so it all restarts, but the stop timer code does not work.
In the module where stopFormTimer, setFormTimer and StartTimerShutdownForm is located, at the top I declare these
Dim OpenTimer As Date
Dim FormTimer As Date
What am i missing here? Why cant i stop the timer and restart the first timer?
I think the problem is you have different proc names in the two subs. They must match. I'd try:
Sub setFormTimer()
FormTimer = Now + TimeValue("00:00:10")
Application.OnTime EarliestTime:=FormTimer, Procedure:="Shutdown", Schedule:=True
End Sub
Sub stopFormTimer()
Application.OnTime EarliestTime:=FormTimer, Procedure:="Shutdown", Schedule:=False
End Sub

excel timer macro not working, "macro can't be found or macros not enabled"

So I've built this timer macro that more than one youtube person has specified how to build in this exact same way, but it still refuses to work.
Sub StartTimer()
Application.OnTime Now + TimeValue("00:00:01"), "nextTime"
End Sub
Sub nextTime()
If Sheet1.Range("I1") = 0 Then Exit Sub
End If
Range("I1").Value = Range("I1").Value - TimeValue("00:00:01")
StartTimer
End Sub
Sub StopTimer()
Application.OnTime Now + TimeValue("00:00:01"), "nextTime", , False
End Sub
The problem arises in the line of code within the StartTimer Subroutine. The nextTime method simply does not get recognized, as the Error says:
The macro may not be available in this workbook or all macros may be disabled. This is obviously not the case as all of my other macros work, and the subroutine is right there. What are your suggestions?
Move your code out of the worksheet code module and put it into a normal code module.
Alternatively, you could call it by fully qualifying it as Sheet1.nextTime (where Sheet1 needs to be the worksheet code name where the code resides), but I think it is probably better to put it into the project level code module.
You also need to remove the End If from the nextTime subroutine.
And you need to fix the StopTimer routine to pass the correct time - i.e. the time at which the next event is due to run.
Public nextRunTime As Date
Sub StartTimer()
nextRunTime = Now + TimeValue("00:00:01")
Application.OnTime nextRunTime, "nextTime"
End Sub
Sub nextTime()
If Sheet1.Range("I1") = 0 Then Exit Sub
Range("I1").Value = Range("I1").Value - TimeValue("00:00:01")
StartTimer
End Sub
Sub StopTimer()
Application.OnTime nextRunTime, "nextTime", , False
End Sub

Application On time

I am facing few issues with my OnTime-method in vba. The code is supposed to run every 30 minutes, but somehow it runs a few more times in between. I am assuming this is because several OnTime-methods might be running when I reset and rerun the code. So I wanted to kill the on time function but getting error. Here is my code below:
Initial code:
Sub autorefresh()
dim timetorun
timetorun = Now + TimeSerial(0, 30, 0)
Application.OnTime timetorun, "manager" 'this runs the macro manager which
'runs several other macros and in
'the end calls this macro again in
'order to reset the timetorun counter
End Sub
I revised the below code to reset the ontime if needed.
Public timetorun As Date 'so that timetorun can be used in both the functions
Sub autorefresh()
timetorun = Now + TimeSerial(0, 30, 0)
Application.OnTime timetorun, "manager"
End Sub
Sub killontime()
Application.OnTime earliesttime:=timetorun, procedure:="manager", schedule:=False '<~~this line gives the error
End Sub
Thanks all of you... After suggestions from R3uk and eirikdaude, the following code works perfectly:
Public timetorun As Double
Sub autorefresh()
timetorun = Now + TimeSerial(0, 30, 0)
Application.OnTime timetorun, "manager"
End Sub
Sub killontime()
Application.OnTime timetorun, "manager", , False
End Sub
You are declaring timetorun 2 times :
one as a Public variable and
one as a Local variable in autorefresh where you fill it, so you'll have an empty timetorun in killontime and that is why you've got the error
More details in here : CPearson on OnTime method
So you code should look like this :
Public TimeToRun As Date 'so that timetorun can be used in both the functions
Sub autorefresh()
TimeToRun = Now + TimeSerial(0, 30, 0)
'this runs the macro manager which runs several other macros and _
'in the end calls this macro again in order to reset the timetorun counter...
Application.OnTime TimeToRun, "manager"
End Sub
'I added the below code to reset the ontime if needed.
Sub killontime()
Application.OnTime _
earliesttime:=TimeToRun, _
procedure:="manager", _
schedule:=False
End Sub
Sub Manager()
'your code as it is now
'Call autorefresh to reset the OnTime method to another 30 seconds
autorefresh
End Sub

Creating a Macro in Excel which executes the other Macro every 2 seconds

I have a macro called UpdateMacro which updates my Database from my Excel
I want to create a macro called RepeatMacro where it executes the UpdateMacro every 2 seconds automatically and only Start and Stop Buttons are to be provided to start and Stop execution of the RepeatMacro.
How can it be done?
Google for Application.OnTime
E.g.
Dim dtNextRunTime As Date
dtNextRunTime = Now + TimeSerial(0,0,2)
Application.OnTime dtNextRunTime, "MyProcedure", True
To clear a previously set procedure, you need to save the time at which it was scheduled )e.g. dtNextRunTime above), then use:
Application.OnTime dtNextRunTime, "MyProcedure", False
Here's a sample VB module with methods StartSchedule / StopSchedule to get you going:
Private m_dtScheduledTime As Date
Private m_lDelaySeconds As Long
Private m_bIsScheduled As Boolean
Private Sub DoWork()
m_bIsScheduled = False
' ... do your work
' Reschedule at the same frequency once completed
StartSchedule m_lDelaySeconds, "DoWork"
End Sub
Public Sub StartSchedule(ByVal DelaySeconds As Long)
StopSchedule
m_lDelaySeconds = DelaySeconds
m_dtScheduledTime = Now + TimeSerial(0, 0, m_lDelaySeconds)
Application.OnTime m_dtScheduledTime, "DoWork", True
m_bIsScheduled = True
End Sub
Public Sub StopSchedule()
If m_bIsScheduled Then
Application.OnTime m_dtScheduledTime, "DoWork", False
m_bIsScheduled = False
End If
End Sub
This will run UpdateMacro every two seconds, assuming UpdateMacro takes less than two seconds to run.
Sub RepeatMacro()
Dim lastRunTime
Do
lastRunTime = Now
Range("A1") = "Last run: " & Format(lastRunTime, "hh:nn:ss")
Call UpdateMacro
DoEvents
Application.Wait lastRunTime + TimeValue("00:00:02")
Loop
End Sub
Sub UpdateMacro()
Debug.Print "running UpdateMacro"
End Sub
EDIT To start and stop RepeatMacro from your sheet, make a start button and a stop button, and put the following code in your Sheet module. Also notice that I added a DoEvents in RepeatMacro above.
Private Sub StartButton_Click()
Call RepeatMacro
End Sub
Private Sub StopButton_Click()
MsgBox "Stopped."
End
End Sub
Now just saying End is poor practice, but you get the idea.