Auto run a macro on a specified date

Rupert Bennett

Active Member
Joined
Nov 20, 2002
Messages
271
I would like to run a macro on Dec 31st each year. the workbook will be opened, but not necessarily being used on that day so I would like the macro to run by itself. I can code what functions need to be performed. I just do not know how to write the code for the date to be recognized and then do the tasks. Can anyone help with this, if it is possible and also say what module I would place the code in?
Your help will be greatly appreciated.
Rupert
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Joe Was

MrExcel MVP
Joined
Feb 19, 2002
Messages
7,539
This checks the date and if it is the one listed in the code it runs the code!

It works by checking the date each time the workbook is opened!

Private Sub Workbook_Open()
'This code go's into the "ThisWorkbook" module.
Dim myTime
myTime = Time

'If today is older than the date below run:
If Now() >= #9/20/2004# Then
MsgBox "Time is Up!"
End If

'If the time is between the times below run:
If Time >= "6:00:00 PM" And Time <= "6:35:00 PM" Then
myMsg = MsgBox(prompt:="The current System-Time is:" & _
vbCr & vbCr & " " & _
FormatDateTime(myTime, vbLongTime) & vbCr & vbCr & vbCr & _
" and, ""Today"" is:" & vbCr & vbCr & _
FormatDateTime(Date, vbLongDate) & vbCr & vbCr, Title:=Now())
End If

End Sub

Sub Test()
Dim myTime
myTime = Time

'If today is older than the date below run:
If Now() >= #9/20/2004# Then
MsgBox "Time is Up!"
End If

'If the time is between the times below run:
If Time >= "6:00:00 PM" And Time <= "6:35:00 PM" Then
myMsg = MsgBox(prompt:="The current System-Time is:" & _
vbCr & vbCr & " " & _
FormatDateTime(myTime, vbLongTime) & vbCr & vbCr & vbCr & _
" and, ""Today"" is:" & vbCr & vbCr & _
FormatDateTime(Date, vbLongDate) & vbCr & vbCr, Title:=Now())
End If
End Sub

Sub myDT()
Dim myTime
myTime = Time

'If today is older than the date below run:
If Now() >= #9/20/2004# Then
MsgBox "Time is Up!"
End If

myMsg = MsgBox(prompt:="The current System-Time is:" & _
vbCr & vbCr & " " & _
FormatDateTime(myTime, vbLongTime) & vbCr & vbCr & vbCr & _
" and, ""Today"" is:" & vbCr & vbCr & _
FormatDateTime(Date, vbLongDate) & vbCr & vbCr, Title:=Now())
End Sub
 

parry

MrExcel MVP
Joined
Aug 20, 2002
Messages
3,355
Hi Joe hows things? :biggrin:

Apologies if I havent looked at your code closely enough but wont this run more than once? I would have thought you would need to store the date the last time the macro run and then test if its >= 1 year since last running then run the macro. As part of your macro you would have to update the date last run where-ever it happens to be stored (like in a hidden sheet for example).

regards
Graham.
 

parry

MrExcel MVP
Joined
Aug 20, 2002
Messages
3,355
Heres my version...

1) Create a new sheet and name the sheet HiddenSheet.
2) In cell A1 enter the date 12/31/2005 (the next time the macro will run is on 31 Dec 2005)
3) Open the VBE (Alt+F11), d-click on the ThisWorkbook object in the left hand window (looks like explorer tree)
4) Post the code below into the right hand window and close the VBE (File|Close). Note you will need to change the name of the macro being called in the code.
5) Hide the sheet

Code:
Private Sub Workbook_Open()
Dim DateDueRun As Date, StrDate As String

'Amend the sheet name where you store the date as required.
'Note the date represents the next day its due to run rather than the last time
'the macro has run
DateDueRun = Format(Sheets("HiddenSheet").Range("A1").Value, "MM/DD/YYYY")

'Ensure the sheet is hidden
Sheets("HiddenSheet").Visible = xlVeryHidden

'If date is equal to or greater than today then...
If Date >= DateDueRun Then
    'Run your macro. Rename MyMacro to the name of your macro
    Call MyMacro
    
    'Obtain the next date to run the macro
    StrDate = Month(DateDueRun) & "/" & Day(DateDueRun) & "/" & Val(Year(DateDueRun) + 1)
    
    'Update the cell storing the date
    Sheets("HiddenSheet").Range("A1").Value = Format(StrDate, "MM/DD/YYYY")
End If

End Sub
 

Rupert Bennett

Active Member
Joined
Nov 20, 2002
Messages
271

ADVERTISEMENT

My thanks and appreciation to Joe and Parry for helping with this problem. I think I will use Parry's solution because I understand it a bit more and it seems it will do exactly what I want, which is to run the code once every year on December 31.
Thanks Again.
Rupert
 

parry

MrExcel MVP
Joined
Aug 20, 2002
Messages
3,355
No problem. You can test it out by changing the system date on your PC to 31 Dec 2005 then open the book and see if it runs it.
 

Rupert Bennett

Active Member
Joined
Nov 20, 2002
Messages
271

ADVERTISEMENT

I just finished testing the code and it worked perfectly. The date on the hidden sheet was then reset to 12/31/06 when the code will run again just like I want. I will now reset my date so it will run on 12/31/05. Thank you so much.
Rupert
 

Joe Was

MrExcel MVP
Joined
Feb 19, 2002
Messages
7,539
You are right the code will run more than once, this is to test for the PC or workbook not being opened on the trigger date!

The code was designed to be a times-up for a workbook test-drive. So after a certain date it will always run. I thought the user could modify the code to run once if needed!
 

chiello

Well-known Member
Joined
Jan 18, 2005
Messages
848
An other simpler solution ...
Insert the code in Thisworkbook module...

Private Sub Workbook_Open()
Dim MyDay As Long, MyMonth As Long
Dim CheckDate As Date, RunIN As Date

'Data acquisition
CheckDate = Now
MyDay = Day(CheckDate)
MyMonth = Month(CheckDate)

'Check of Day/Month
If MyDay = 31 And MyMonth = 12 Then
'Specify time to last from opening to execution (15 seconds in this example)
RunIN = TimeValue("00:00:15")
Application.OnTime Now + RunIN, "my_Procedure" 'change the name of the macro being called.
End If
End Sub

Ciao
 

Forum statistics

Threads
1,148,048
Messages
5,744,501
Members
423,881
Latest member
Nguyen Vu

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
Top