How to run a macro at a particular time, then re-run it at specified interval and end it at a particular time?

nachiketdp

Board Regular
Joined
Jan 31, 2007
Messages
53
Dear All,

I wish to run an excel macro at a particular time, say 7:00 am and would like to run it at a specified interval, say every hour till a particular time, say 5:00 PM. What could be the appropriate code for it? My start time, end time and interval all three would be variables. But I will be still happy if I come across a code involving constants, at least.

Any help will be truly appreciated! Thanks in advance!

Regards,
Nachiket
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
this is kind the pattern you need:

Code:
Dim NextRun As Date


Sub StartSchedule()
' This procedure sets the first run for 07:00
  NextRun = TimeSerial(7, 0, 0)
  Application.OnTime NextRun, "MyMacro"
End Sub


Sub MyMacro()
' ==============================
' Your processing code goes here
' ==============================

' The next part schedules another run in an
' hour's time, but only if it's before 17:00

  If Now() < Date + TimeSerial(17, 0, 0) Then
    NextRun = Now() + TimeSerial(1, 0, 0)
    Application.OnTime NextRun, "MyMacro"
  End If
End Sub


Sub StopSchedule()
' This procedure terminates the schedule
  Application.OnTime NextRun, "MyMacro", , False
  
' Note that the schedule will
' also end once you quit Excel
End Sub
 
Upvote 0
Just one query. How should I trigger the startSchedule macro? Should I put it in workbook_open event? Or will it work automatically?
 
Upvote 0
Hi ParamRay,

I have one question. I developed my code but I am getting the output twice. In other words, the macro runs twice. I am puzzles as to how this happens. Can you please guide me?

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' This procedure terminates the schedule
  On Error Resume Next
  Application.OnTime NextRun, "MyMacro", , False
  On Error GoTo 0
' Note that the schedule will
' also end once you quit Excel

End Sub

Private Sub Workbook_Open()
'Sub StartSchedule()
' This procedure sets the first run for 07:00
  
truth_val = Worksheets("Parameters").Cells(8, 39).Value
If truth_val = True Then Exit Sub
  
  start_hr = Worksheets("Parameters").Cells(5, 2)
  start_hr = Val(start_hr)
  start_min = Worksheets("Parameters").Cells(5, 3)
  start_min = Val(start_min)
  
  NextRun = TimeSerial(start_hr, start_min, 0)
  Application.OnTime NextRun, "MyMacro"
'End Sub

End Sub


Sub MyMacro()
' ==============================
' Your processing code goes here
' ==============================


'actual execution
Dim time_stamp As Date, date_stamp As Date

Application.ScreenUpdating = False
othfil = ActiveWorkbook.Name
ThisWorkbook.Activate
Calculate
time_stamp = Worksheets("Parameters").Cells(5, 40)
date_stamp = Worksheets("Parameters").Cells(5, 39)
Lcol = Worksheets("Übersicht").Cells(17, Columns.Count).End(xlToLeft).Column

For i = 2 To Lcol
sheet_no = Worksheets("Übersicht").Cells(17, i)
sheet_ref = "H_" & sheet_no
V1 = Worksheets("Übersicht").Cells(18, i)
V2 = Worksheets("Übersicht").Cells(19, i)
V3 = Worksheets("Übersicht").Cells(20, i)
V4 = Worksheets("Übersicht").Cells(21, i)
V5 = Worksheets("Übersicht").Cells(22, i)
V6 = Worksheets("Übersicht").Cells(23, i)

Lrow = Worksheets(sheet_ref).Cells(Rows.Count, "A").End(xlUp).Row + 1
Worksheets(sheet_ref).Cells(Lrow, 1) = date_stamp
Worksheets(sheet_ref).Cells(Lrow, 2) = time_stamp
Worksheets(sheet_ref).Cells(Lrow, 3) = V1
Worksheets(sheet_ref).Cells(Lrow, 4) = V2
Worksheets(sheet_ref).Cells(Lrow, 5) = V3
Worksheets(sheet_ref).Cells(Lrow, 6) = V4
Worksheets(sheet_ref).Cells(Lrow, 7) = V5
Worksheets(sheet_ref).Cells(Lrow, 8) = V6

Next i

' The next part schedules another run in an
' hour's time, but only if it's before 17:00

end_hr = Worksheets("Parameters").Cells(9, 2)
  end_hr = Val(end_hr)
  end_min = Worksheets("Parameters").Cells(9, 3)
  end_min = Val(end_min)
  
int_hr = Worksheets("Parameters").Cells(7, 2)
  int_hr = Val(int_hr)
  int_min = Worksheets("Parameters").Cells(7, 3)
  int_min = Val(int_min)
  
  If Now() < Date + TimeSerial(end_hr, end_min, 0) Then
    NextRun = Now() + TimeSerial(int_hr, int_min, 0)
    Application.OnTime NextRun, "MyMacro"
  End If
  Workbooks(othfil).Activate
  Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,048
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top