Timed Macros

diggerdidoodar

Board Regular
Joined
May 20, 2002
Messages
59
Got the following code off the forum which works great to run the macro evey 10 seconds.

What I really want is to run it at a certain time in the morning
Can anyone please help

PS:- The actual code procedure code is just a test, I don't really want to write my name 100's of times.

Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long
Public TimerSeconds As Single

Sub StartTimer()
TimerSeconds = 10 ' how often to "pop" the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
'
Workbooks.Open Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls"
Range("C6").Select
ActiveCell.FormulaR1C1 = "D a v I d"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C30"), Type:=xlFillDefault
Range("C6:C30").Select
Range("C6").Select
Selection.Copy
Range("D6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D6:D30"), Type:=xlFillDefault
Range("D6:D30").Select
Range("D6").Select
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E6:E30"), Type:=xlFillDefault
Range("E6:E30").Select
Range("E6").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("F6:F30"), Type:=xlFillDefault
Range("F6:F30").Select
Range("A3").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
'
End Sub


Cheers Diggerdi
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

diggerdidoodar

Board Regular
Joined
May 20, 2002
Messages
59
Timed Macro's

Thanks for the reply & your reply yesterday, I noticed this coding yesterday but was none the wiser.
Where & how would I fit this into my original coding??

Cheers Diggerdi
 

StevenD

Active Member
Joined
Nov 17, 2004
Messages
262
Hi Diggerdi,

The code that you want executed at a certain time is placed where I have written 'Do work at this point.

Then put the other code in a new module.

Changing "TheSub" to whatever your sub name is containing the time statement.

This then works by checking using the timer every 20 seconds if the time falls within the window.

Hope this helps.
 

diggerdidoodar

Board Regular
Joined
May 20, 2002
Messages
59

ADVERTISEMENT

Timed Macro

A bit confused, done as you said:-

Code in Blue in a module, Code in Violet in another module but program is till running every 10 seconds, I only want it to run a a certain time.
Are the end if wrong or is it that I've a 24hr clock??:-

Hope you can help

Sub Timetest()


If Time < #1:09:59 PM# And Time > #1:11:01 PM# Then
runonce = 1
End If
If runonce = 0 Then
If Time < #1:10:00 PM# And Time > #1:11:00 PM# Then
runonce = 1

End If

Workbooks.Open Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls"
Range("C6").Select
ActiveCell.FormulaR1C1 = "D a v I d"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C30"), Type:=xlFillDefault
Range("C6:C30").Select
Range("C6").Select
Selection.Copy
Range("D6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D6:D30"), Type:=xlFillDefault
Range("D6:D30").Select
Range("D6").Select
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E6:E30"), Type:=xlFillDefault
Range("E6:E30").Select
Range("E6").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("F6:F30"), Type:=xlFillDefault
Range("F6:F30").Select
Range("A3").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
StartTimer


End If
End Sub


Public RunWhen As Double
Public Const cRunIntervalSeconds = 10 ' two minutes
Public Const cRunWhat = "Timetest"


Sub StartTimer()

RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub
 

StevenD

Active Member
Joined
Nov 17, 2004
Messages
262
Hi,

Put the end if down by the other one.

It will only carry out the code inbetween now when the time is within that window.
 

diggerdidoodar

Board Regular
Joined
May 20, 2002
Messages
59

ADVERTISEMENT

I've put the to end ifs at the bottom & commented out the end if under the runonce = 1, but still no success, nothings every easy.

Cheers Diggerdidoodar
 

StevenD

Active Member
Joined
Nov 17, 2004
Messages
262
Try this

Code:
Sub timetest()
'check whether time is falls outside window if so reset runonce

If Time < st - TimeSerial(0, 0, -1) And Time > st + TimeSerial(0, 0, 61) Then
runonce = 0
End If
    'check whether time is within window
    If Time > st And Time < st + TimeSerial(0, 0, 60) Then
        'check whether process has already been done once today
        If runonce = 0 Then
            'set that process has been run within window
            runonce = 1
            Workbooks.Open Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls"
Range("C6").Select
ActiveCell.FormulaR1C1 = "D a v I d"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C30"), Type:=xlFillDefault
Range("C6:C30").Select
Range("C6").Select
Selection.Copy
Range("D6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D6:D30"), Type:=xlFillDefault
Range("D6:D30").Select
Range("D6").Select
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E6:E30"), Type:=xlFillDefault
Range("E6:E30").Select
Range("E6").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("F6:F30"), Type:=xlFillDefault
Range("F6:F30").Select
Range("A3").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End If
End If


StartTimer

End Sub

The runonce ensures that it will only do it once within the window.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,912
Messages
5,598,833
Members
414,260
Latest member
joishe

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