Start/Repeat/Stop Macro at specific time/interval

[Guest]

Hi All,
I have a macro that I would like to start at 8:30am and then repeat every 15
seconds, and stop at 3pm. I did look at cperson.com but I am unsure of how
to write this specifically. Thanks,

 

[Guest]

Hi,

Try this one, as your req. Place in standard module

Option Explicit
Dim add

Sub Scheduled()
Application.OnTime TimeValue("08:" & Format(add, "00") & ":00"),
"Procedure"
End Sub

Sub Procedure()
add = add + 1
If Format(Now, "m") = 3 Then End
Scheduled
End Sub

Sub test()
add = 1
Scheduled
End Sub


'Then run test

 

[Guest]

Thanks Halim,
I am fairly new at VBA. What part of the code says to repeat the macro
every 15 secs? I might like to change this varible in the future. Thanks!

 

[Dave Peterson]

Chip Pearson explains how to use application.ontime:
http://www.cpearson.com/excel/ontime.htm

 

[Guest]

Thanks Dave. I have very limited experience with VBA. I have been on Chip
Pearson's site before I wrote this question and I don't fully understand how
to write this macro. (I am trying to teach myself VBA as we speak.) Could
you please help clarify how to start a macro at 830am and then repeat the
macro every 15 secs and end it at 3pm? Thanks!

 

[Dave Peterson]

This assumes that you don't open this workbook until after 8:30 AM:

Option Explicit
Public RunWhen As Double
Public Const cRunIntervalSeconds = 15
Public Const cRunWhat = "The_Sub" ' the name of the procedure to run
Dim FirstTime As Boolean

Sub StartTimer()
If FirstTime Then
RunWhen = TimeSerial(8, 30, 0)
Else
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
End If
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True
End Sub

Sub The_Sub()

MsgBox "hi " & Time
'''''''''''''''''
' Your Code Here
'''''''''''''''''
' Call StartTimer to schedule the procedure again
If Time > TimeSerial(15, 0, 0) Then
'do nothing
Else
StartTimer
End If
End Sub

Sub StopTimer()
'still useful for testing to stop any scheduled macro
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False
End Sub

Sub Auto_Open()
FirstTime = True
If Time > TimeSerial(8, 30, 0) Then
FirstTime = False
End If
Call StartTimer
FirstTime = False
End Sub

This does assume that you close excel before midnight and reopen this file the
next day.

 

[Dave Peterson]

Ignore that first note--I changed the code but forgot to delete the note. This
fixes a word wrap problem, too:

Option Explicit
Public RunWhen As Double
Public Const cRunIntervalSeconds = 15
Public Const cRunWhat = "The_Sub" ' the name of the procedure to run
Dim FirstTime As Boolean
Sub StartTimer()
If FirstTime Then
RunWhen = TimeSerial(8, 30, 0)
Else
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
End If
Application.OnTime EarliestTime:=RunWhen, _
Procedure:=cRunWhat, Schedule:=True
End Sub
Sub The_Sub()

MsgBox "hi " & Time
'''''''''''''''''
' Your Code Here
'''''''''''''''''
' Call StartTimer to schedule the procedure again
If Time > TimeSerial(15, 0, 0) Then
'do nothing
Else
StartTimer
End If
End Sub
Sub StopTimer()
'useful for testing to stop any scheduled macro
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, _
Procedure:=cRunWhat, Schedule:=False
End Sub
Sub Auto_Open()
FirstTime = True
If Time > TimeSerial(18, 30, 0) Then
FirstTime = False
End If
Call StartTimer
FirstTime = False
End Sub

But this still applies:

This does assume that you close excel before midnight and reopen this file the
next day.

Dave Peterson wrote:
<<snipped>>

 

[Guest]

Excellent! It works perfectly!
Clarification: I should close this file by midnight each night. And, if I
open this file before 830am will it still work the same? As of now, I open
this file before 830am so that it runs while I am at work. Thanks!

 

[Dave Peterson]

First, there was a(nother) typo in that code and a bug:

Instead of telling you what to change, here's the revised code:

Option Explicit
Public RunWhen As Double
Public Const cRunIntervalSeconds = 15
Public Const cRunWhat = "The_Sub" ' the name of the procedure to run
Dim FirstTime As Boolean
Sub StartTimer()
If FirstTime Then
'changed for today + 8:30 AM
RunWhen = Date + TimeSerial(8, 30, 0)
Else
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
End If
Application.OnTime EarliestTime:=RunWhen, _
Procedure:=cRunWhat, Schedule:=True
End Sub
Sub The_Sub()
MsgBox "hi " & Time
'''''''''''''''''
' Your Code Here
'''''''''''''''''
' Call StartTimer to schedule the procedure again
If Time > TimeSerial(15, 0, 0) Then
'do nothing
Else
StartTimer
End If
End Sub
Sub StopTimer()
'useful for testing to stop any scheduled macro
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, _
Procedure:=cRunWhat, Schedule:=False
End Sub
Sub Auto_Open()
FirstTime = True
'Changed for 8:30 AM
If Time > TimeSerial(8, 30, 0) Then
FirstTime = False
End If
Call StartTimer
FirstTime = False
End Sub

========

And this is the portion that does what you're asking about.

Sub StartTimer()
If FirstTime Then
RunWhen = Date + TimeSerial(8, 30, 0)
Else
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
End If
Application.OnTime EarliestTime:=RunWhen, _
Procedure:=cRunWhat, Schedule:=True
End Sub
and
Sub Auto_Open()
FirstTime = True
If Time > TimeSerial(8, 30, 0) Then
FirstTime = False
End If
Call StartTimer
FirstTime = False
End Sub

So when the workbook opens, it looks at the time in the Auto_Open routine. If
it's after 8:30 AM, it says to pretend that starting the timer isn't the first
time.

Then in the StartTimer, it looks at that firsttime variable. If firsttime is
true (before 8:30 AM), then turn on the timer so that it runs at the next 8:30.
If firsttime is false, it just says to run in 15 seconds.

Excellent! It works perfectly!
Clarification: I should close this file by midnight each night. And, if I
open this file before 830am will it still work the same? As of now, I open
this file before 830am so that it runs while I am at work. Thanks!

:

<<snipped>>

 

[Guest]

Thanks for your time Dave. I learned a lot and I really appreciate the
tutorial!
Andy

 

[Dave Peterson]

Hope it works ok for you.

Sorry it took so many attempts to modify Chip's original code.