Execute a macro at specific time issues, newbie please help!

[alpha8484]

Hi team, new user and not very comfortable with VBA. I am trying to have a macro run every day at a specific time interval. Right now I am using 2 modules. I was trying to set the below for 16:00:00. The code runs fine when I execute it but for some reason, it's not running on its own. Sometimes it has run on its own but I have no idea what was different... I tried a few different expressions with how you can use the ontime application. My goal is to just have the excel open and for it to run the macro. Thanks for the thoughts and help!






Module 1:

Sub Run_Time()
Application.OnTime "18:25:00", "Module2.Capture_Cell_Value"
End Sub

Module 2:

Sub Capture_Cell_Value()

Dim val As Variant

Sheets("Master").Select

val = Range("J17").Value

Sheets("Graph").Select

lRow = Cells(Rows.Count, 1).End(xlUp).Row

Cells(lRow + 1, 2).Value = val

Cells(lRow + 1, 1).Value = Date

End Sub

 

[GWteB]

Hi & welcome to MrExcel.

The code runs fine when I execute it but for some reason, it's not running on its own.

The moment you schedule a time for a macro to be invoked, that macro will be invoked once. For a desired repetition you will have to schedule a new time.
I have modified the code of both procedures. Furthermore, I have given a more appropriate name to the procedure responsible for setting the desired time.

This procedure schedules the invocation of the desired macro at the desired time.
Note that it's not necessary to precede the macro name with the name of the module that contains that macro.

Public Sub ScheduleTimeToRun()
   
    Dim ScheduledDay As Double, ScheduledTime As Double
   
    ScheduledDay = VBA.Date
    ScheduledTime = VBA.TimeValue("18:25:00")       ' <<<< change time to suit
   
    If VBA.Time > ScheduledTime Then
        ScheduledDay = ScheduledDay + 1
    End If
    Application.OnTime (ScheduledDay + ScheduledTime), "Capture_Cell_Value"
End Sub

This procedure is the scheduled one. Note that the last line of code ensures a new scheduled time.
Also note that there's no need to select a sheet prior to accessing a cell.

Public Sub Capture_Cell_Value()

    Dim val As Variant

    val = Sheets("Master").Range("J17").Value
    With Sheets("Graph")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(lRow + 1, 2).Value = val
        .Cells(lRow + 1, 1).Value = Date
    End With
   
    ScheduleTimeToRun     ' <<<<
End Sub

In order to let this all happen automagically, the workbook open event can be used to fire the macro that schedules the other macro.
The code for that event handler is to be put in the ThisWorkbook module and looks like this:

Private Sub Workbook_Open()
    ScheduleTimeToRun     ' <<<<
End Sub

Hope this helps.

 

[alpha8484]

Thank you so much for all the details and reply. Can this be added into one module or is there a reason why it would have to be separated?

 

[GWteB]

Glad to help.

The code of the Workbook_Open event handler needs to be in the already existing module named ThisWorkbook, otherwise that code will never be fired when opening your workbook.
The other two procedures can be placed together in the same (standard) module.
If you absolutely want to have all procedures together in one module, then that should be the ThisWorkbook module, but I would advise against that for several reasons.

 

[alpha8484]

Ok Thanks, So it just executed with this code excluding the Workbook_open section:

Public Sub ScheduleTimeToRun()

Dim ScheduledDay As Double, ScheduledTime As Double

ScheduledDay = VBA.Date
ScheduledTime = VBA.TimeValue("21:00:00")

If VBA.Time > ScheduledTime Then
ScheduledDay = ScheduledDay + 1
End If
Application.OnTime (ScheduledDay + ScheduledTime), "Capture_Cell_Value"
End Sub

Public Sub Capture_Cell_Value()

Dim val As Variant

val = Sheets("Master").Range("J17").Value
With Sheets("Graph")
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(lRow + 1, 2).Value = val
.Cells(lRow + 1, 1).Value = Date
End With

ScheduleTimeToRun
End Sub



But it filled 153 cells repeating the data, any idea why?

 

[GWteB]

I see. Excel's resolution of time is a bit lower than the high time resolution of the computer. I should have taken that into account.
If it is checked not only whether the current time has already passed the desired time to be scheduled, but also whether both times are equal, then the problem should be solved.

Public Sub ScheduleTimeToRun()
   
    Dim ScheduledDay As Double, ScheduledTime As Double
   
    ScheduledDay = VBA.Date
    ScheduledTime = VBA.TimeValue("18:25:00")       ' <<<< change time to suit
   
    If VBA.Time >= ScheduledTime Then
        ScheduledDay = ScheduledDay + 1
    End If
    Application.OnTime (ScheduledDay + ScheduledTime), "Capture_Cell_Value"
End Sub

 

[alpha8484]

So I gave that a try and the program freezes now and spikes the GPU to 15%....any suggestions on how to open it in safe more or where the macro doesn't run?

 

[GWteB]

I see. A few moments ago I did a test and it works for me.
The scheduled macro just runs once (instead of 278 times on my machine before it stops repeating ...)
However, I forgot an important point. The moment the workbook is closed we have to cancel the scheduled macro, and we didn't. That might be the cause of your issue.

Close your workbook and quit Excel.
Restart Excel > New workbook > Ribbon > File > Open > Browse > select your workbook > click on Open dropdown > click Open in protected View > at the first warning click Enable edititing > at the second warning click disable macros.
Now you're able to edit your code, although you cannot run any code within that specific workbook.

The code below is a replacement for the code I previously supplied.
Hopefully this will resolve your current issue.

This goes in the ThisWorkbook module:

Option Explicit

Private Sub Workbook_Open()
    ScheduleTimeToRun
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ScheduleCancel
End Sub

This goes at the top of a standard module:

Option Explicit

Private Type TLocals
    ScheduledTime As Double         ' <<< storage for scheduled date & time
    Macro         As String         ' <<< storage for macro to be scheduled
End Type
Private this As TLocals


Public Sub ScheduleCancel()
    On Error Resume Next
    Application.OnTime EarliestTime:=this.ScheduledTime, Procedure:=this.Macro, Schedule:=False
End Sub


Public Sub ScheduleTimeToRun()
   
    Dim ScheduledDay As Double, NextTime As Double
   
    ScheduledDay = VBA.Date
    NextTime = VBA.TimeValue("18:25:00")            ' <<<< change time to suit
   
    If VBA.Time >= NextTime Then
        ScheduledDay = ScheduledDay + 1
    End If
    With this
        .ScheduledTime = ScheduledDay + NextTime
        .Macro = "Capture_Cell_Value"               ' <<<< change macro name to suit
        Application.OnTime .ScheduledTime, .Macro
    End With
End Sub


Public Sub Capture_Cell_Value()
    Dim val As Variant, lRow As Long
    val = Sheets("Master").Range("J17").Value
    With Sheets("Graph")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(lRow + 1, 2).Value = val
        .Cells(lRow + 1, 1).Value = Date
    End With
   
    ScheduleTimeToRun     ' <<<<
End Sub