VBA - Run a macro at a set time based on a condition.

[Chapster5]

Good evening all!

Wondering if I can pick your brains. Basically I have a recorded macro that is currently run by clicking a button what I would like is the recorded macro to run at 10 past the hour every hour only if a range of cells are all greater than 0

For example let's say I have a range A1:F10... At 10 past the hour the macro checks if ALL cells in this range are greater than 0 if so then proceed to run the already recorded macro. If even 1 of the cells is 0 then wait say 3 seconds and check again. Once the macro is successful then wait until the next 10 past the hour and then repeat again... Check the range and so forth.

Is this possible to do at all?

I appreciate any help!


Thank you

Nick

 

[John_w]

Put this code in a module - the same module as your recorded macro or a new module.

Const CheckHourlyMinutes = 10
Const CheckAgainSeconds = 3

Public NextRunTime As Date
Public CheckSeconds As Long

Public Sub StartTimer()

    If CheckSeconds = 0 Then
        'Run Check_Range at specified minutes past the hour
        If Minute(Now) < CheckHourlyMinutes Then
            NextRunTime = Date + TimeSerial(Hour(Now), CheckHourlyMinutes, 0)
        Else
            NextRunTime = Date + TimeSerial(Hour(Now) + 1, CheckHourlyMinutes, 0)
        End If
    Else
        'Run Check_Range in specified seconds
        NextRunTime = DateAdd("s", CheckSeconds, Now)
    End If
    
    Debug.Print Time; "Next run time = " & NextRunTime    
    Application.OnTime EarliestTime:=NextRunTime, Procedure:="Check_Range", Schedule:=True

End Sub


Public Sub Check_Range()

    With ThisWorkbook.Worksheets("Sheet1")
        If WorksheetFunction.CountIf(.Range("A1:F10"), ">0") = .Range("A1:F10").Count Then
            Recorded_Macro
            CheckSeconds = 0
        Else
            CheckSeconds = CheckAgainSeconds
        End If
    End With
    
    StartTimer  'Reschedule the procedure
    
End Sub


Public Sub Recorded_Macro()
    Debug.Print Time; "Recorded_Macro"
End Sub


Public Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=NextRunTime, Procedure:="Check_Range", Schedule:=False
End Sub

My 'recorded' macro is a procedure named Recorded_Macro, so change the call to it in Check_Range to the name of your macro.

You can change the first Const value at the top of the code to test the code without waiting until 10 past the hour.

Run the StartTimer procedure to start checking cells A1:F10 on Sheet1.

Add this code to the ThisWorkbook module to start and stop the checking when you open or close the workbook:

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

 

[Chapster5]

Put this code in a module - the same module as your recorded macro or a new module.

Const CheckHourlyMinutes = 10
Const CheckAgainSeconds = 3

Public NextRunTime As Date
Public CheckSeconds As Long

Public Sub StartTimer()

    If CheckSeconds = 0 Then
        'Run Check_Range at specified minutes past the hour
        If Minute(Now) < CheckHourlyMinutes Then
            NextRunTime = Date + TimeSerial(Hour(Now), CheckHourlyMinutes, 0)
        Else
            NextRunTime = Date + TimeSerial(Hour(Now) + 1, CheckHourlyMinutes, 0)
        End If
    Else
        'Run Check_Range in specified seconds
        NextRunTime = DateAdd("s", CheckSeconds, Now)
    End If
   
    Debug.Print Time; "Next run time = " & NextRunTime   
    Application.OnTime EarliestTime:=NextRunTime, Procedure:="Check_Range", Schedule:=True

End Sub


Public Sub Check_Range()

    With ThisWorkbook.Worksheets("Sheet1")
        If WorksheetFunction.CountIf(.Range("A1:F10"), ">0") = .Range("A1:F10").Count Then
            Recorded_Macro
            CheckSeconds = 0
        Else
            CheckSeconds = CheckAgainSeconds
        End If
    End With
   
    StartTimer  'Reschedule the procedure
   
End Sub


Public Sub Recorded_Macro()
    Debug.Print Time; "Recorded_Macro"
End Sub


Public Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=NextRunTime, Procedure:="Check_Range", Schedule:=False
End Sub

My 'recorded' macro is a procedure named Recorded_Macro, so change the call to it in Check_Range to the name of your macro.

You can change the first Const value at the top of the code to test the code without waiting until 10 past the hour.

Run the StartTimer procedure to start checking cells A1:F10 on Sheet1.

Add this code to the ThisWorkbook module to start and stop the checking when you open or close the workbook:

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

Amazing John I'll give that a test and get back to you ASAP!

Appreciate the help!

 

[Chapster5]

Ignore this I dont know how to delete a post

 

[Chapster5]

Put this code in a module - the same module as your recorded macro or a new module.

Const CheckHourlyMinutes = 10
Const CheckAgainSeconds = 3

Public NextRunTime As Date
Public CheckSeconds As Long

Public Sub StartTimer()

    If CheckSeconds = 0 Then
        'Run Check_Range at specified minutes past the hour
        If Minute(Now) < CheckHourlyMinutes Then
            NextRunTime = Date + TimeSerial(Hour(Now), CheckHourlyMinutes, 0)
        Else
            NextRunTime = Date + TimeSerial(Hour(Now) + 1, CheckHourlyMinutes, 0)
        End If
    Else
        'Run Check_Range in specified seconds
        NextRunTime = DateAdd("s", CheckSeconds, Now)
    End If
   
    Debug.Print Time; "Next run time = " & NextRunTime   
    Application.OnTime EarliestTime:=NextRunTime, Procedure:="Check_Range", Schedule:=True

End Sub


Public Sub Check_Range()

    With ThisWorkbook.Worksheets("Sheet1")
        If WorksheetFunction.CountIf(.Range("A1:F10"), ">0") = .Range("A1:F10").Count Then
            Recorded_Macro
            CheckSeconds = 0
        Else
            CheckSeconds = CheckAgainSeconds
        End If
    End With
   
    StartTimer  'Reschedule the procedure
   
End Sub


Public Sub Recorded_Macro()
    Debug.Print Time; "Recorded_Macro"
End Sub


Public Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=NextRunTime, Procedure:="Check_Range", Schedule:=False
End Sub

My 'recorded' macro is a procedure named Recorded_Macro, so change the call to it in Check_Range to the name of your macro.

You can change the first Const value at the top of the code to test the code without waiting until 10 past the hour.

Run the StartTimer procedure to start checking cells A1:F10 on Sheet1.

Add this code to the ThisWorkbook module to start and stop the checking when you open or close the workbook:

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

Amazing John!

It worked an absolute charm!! I appreciate your help!

Nick