I need to have my macro executed every 10 minutes .
This allows it to work in 10 minutes
sub my_Procedure ()
msgbox "hello world"
end sub
sub test()
Application.OnTime Now + TimeValue("00:00:10"), "my_Procedure"
end sub
But this works only once . How can I have my macro execute every 10 minutes ?
You should use this pattern:
Sub my_Procedure()
MsgBox "hello world"
Call test ' for starting timer again
End Sub
Sub test()
Application.OnTime Now + TimeValue("00:10:00"), "my_Procedure"
End Sub
Consider:
Public RunWhen As Double
Public Const cRunWhat = "my_Procedure"
Sub StartTimer()
RunWhen = Now + TimeSerial(0, 10, 0)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub
Sub my_Procedure()
MsgBox "hello world"
Call StartTimer
End Sub
all in a standard module..............be sure to run StopTimer before exiting Excel
NOTE
The "minute" argument in TimeSerial is the second argument.
Related
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
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.
I am trying to create a macro that can automatically close the workbook within 5 minutes plus there will be a pop up reminder message at 4 mins 30 sec. I want the message box to be automatically closed in 10 seconds if user does not click the ok button. I am stuck at the point that the message box cannot close within 10 seconds. Most of my code are copied from the internet. Below are my codes:
In the workbook page:
Private Sub workbook_open()
Call settimer
End Sub
Private Sub workbook_beforeclose(cancel As Boolean)
Call stoptimer
End Sub
Private Sub workbook_sheetcalculate(ByVal sh As Object)
Call stoptimer
Call settimer
End Sub
Private Sub workbook_sheetselectionchange(ByVal sh As Object, _
ByVal target As Excel.Range)
Call stoptimer
Call settimer
End Sub
In the module
Dim downtime As Date
Sub settimer()
downtime = Now + TimeValue("00:01:00")
alerttime = downtime - TimeValue("00:00:50")
Application.OnTime Earliesttime:=alerttime, _
procedure:="alertuser", schedule:=True
Application.OnTime Earliesttime:=Downtime, _
procedure:="shutdown", schedule:=True
End Sub
Sub stoptimer()
On Error Resume Next
Application.OnTime Earliesttime:=downtime, _
procedure:="shutdown", schedule:=False
End Sub
Sub shutdown()
Application.DisplayAlerts = True
With ThisWorkbook
.Save = True
.Close
End With
End Sub
Sub alertuser()
Dim wsshell
Dim intText As Integer
Set wsshell = CreateObject("WScript.Shell")
intText = wsshell.Popup("log sheet will be closed in 30 seconds if there are no more inputs", 10, "reminder")
Set wsshell = Nothing
End Sub
You need to fully qualify your procedure name. It is not finding the procedure in question. You also had a typo and where missing the global variable alerttime. Try this:
Public downtime As Date
Public alerttime As Date
Private Sub workbook_open()
Call settimer
End Sub
Private Sub workbook_beforeclose(cancel As Boolean)
Call stoptimer
End Sub
Private Sub workbook_sheetcalculate(ByVal sh As Object)
Call stoptimer
Call settimer
End Sub
Private Sub workbook_sheetselectionchange(ByVal sh As Object, _
ByVal target As Excel.Range)
Call stoptimer
Call settimer
End Sub
Sub settimer()
downtime = Now + TimeValue("00:01:00")
alerttime = downtime - TimeValue("00:00:50")
'fully qualify your procedure name here and the procedure will run
Application.OnTime Earliesttime:=alerttime, _
procedure:="WorkbookName.xlsm!ThisWorkbook.alertuser", schedule:=True
'and here... also typo was here in downtime
Application.OnTime Earliesttime:=downtime, _
procedure:="WorkbookName.xlsm!ThisWorkbook.shutdown", schedule:=True
End Sub
Sub stoptimer()
On Error Resume Next
Application.OnTime Earliesttime:=downtime, _
procedure:="shutdown", schedule:=False
End Sub
Sub shutdown()
Application.DisplayAlerts = True
With ThisWorkbook
.Save = True
.Close
End With
End Sub
Sub alertuser()
Dim wsshell
Dim intText As Integer
Set wsshell = CreateObject("WScript.Shell")
intText = wsshell.Popup("log sheet will be closed in 30 seconds if there are no more inputs", 10, "reminder")
Set wsshell = Nothing
End Sub
You could use a userform (which you Insert into your project in the VBA editor) which looks something like this:
In the properties window I changed the forms name to formReminder to make it easier to refer to in other modules. Then, in the userform's code window I put:
Private Running As Boolean
Private Sub CommandButton1_Click()
Running = False
End Sub
Private Sub UserForm_Activate()
Dim start As Single
start = Timer
Running = True
Do While Running And Timer < start + 10
DoEvents
Loop
Unload Me
End Sub
Private Sub UserForm_Click()
Running = False
End Sub
When you run the line formReminder.Show anywhere else in the code (e.g. -- in place of where you create the popup) the form will display and show for 10 seconds (or less if you click anywhere on it) and then disappear.
While it displays it will look like this:
Thanks, John Coleman for your answer. It led me to a solution I've wanted for a long time. I took your code and converted it into a generic function that accepts parameters for the message and the number of seconds to wait.
Sub MsgBoxTimerTest()
' Test the Message box with a timer form
Dim vReturn As Variant
vReturn = MsgBoxTimerCall("MessageBox that Dissappears after n Seconds", "Hello World!", 3)
End Sub
' **************************************************************************
Function MsgBoxTimerCall(strCaption As String, strMessage As String, intSeconds As Integer)
' Show a messagebox for a while
' https://stackoverflow.com/questions/37281840/automatic-close-excel-workbook-with-a-pop-up-message
' 2016-06-21
TimerSeconds = intSeconds
msgBoxTimerForm.Caption = strCaption
msgBoxTimerForm.TextBox1.Value = strMessage
msgBoxTimerForm.Show
End Function
' **************************************************************************
' **************************************************************************
Insert this code in the form
' **************************************************************************
Private Running As Boolean
Private Sub CommandButton1_Click()
MsgBox "Yo!"
Running = False
End Sub
Private Sub UserForm_Activate()
Dim start As Single
start = Timer
Running = True
Do While Running And Timer < start + TimerSeconds
DoEvents
Loop
Unload Me
End Sub
Private Sub UserForm_Click()
Running = False
End Sub
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
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.