Edit this "Looping" code to start and stop at specific times?

[Bret1]

I'm using this simple "Looping" code to make my Macro continuously loop every 5 minutes. Is there a way to edit this to make the macro 1st run at 8:15am, then every 5 min, then stop looping at 3:15pm?
I may open the worksheet and run the Macro before 8:30, but I don't want the Macro to execute until 8:15. I also want the Macro looping to execute immediately if I run the Macro after 8:15am, but before 3:15pm.
Thanks

Dim RunTimer As Date

Sub New_Copy_Over_Both_Columns()

RunTimer = Now + TimeValue("00:05:00")
Application.OnTime RunTimer, "New_Copy_Over_Both_Columns"

 

[MoshiM]

I'm using this simple "Looping" code to make my Macro continuously loop every 5 minutes. Is there a way to edit this to make the macro 1st run at 8:15am, then every 5 min, then stop looping at 3:15pm?
I may open the worksheet and run the Macro before 8:30, but I don't want the Macro to execute until 8:15. I also want the Macro looping to execute immediately if I run the Macro after 8:15am, but before 3:15pm.
Thanks

Dim RunTimer As Date

Sub New_Copy_Over_Both_Columns()

RunTimer = Now + TimeValue("00:05:00")
Application.OnTime RunTimer, "New_Copy_Over_Both_Columns"

Is this what you mean?

Dim RunTimer As Date

Sub New_Copy_Over_Both_Columns()

'RunTimer = Now + TimeValue("00:05:00")
    Dim finalTime As Date, currentTime As Date
  
    RunTimer = Date + TimeSerial(8, 15, 0)
    finalTime = Date + TimeSerial(15, 15, 0)
    currentTime = Now
  
    If currentTime < RunTimer Or currentTime >= finalTime Then Exit Sub
  
    Do Until DateDiff("s", RunTimer, finalTime) = 0
        'Directly comparing was allowing an extra loop so datediff in seconds is used
        'Note both times mod 5 minutes = 0
        If RunTimer >= currentTime Then
      
            Application.OnTime RunTimer, "New_Copy_Over_Both_Columns", Schedule:=True
            'Debug.Print RunTimer
            Exit Do
          
        End If
      
        RunTimer = DateAdd("n", 5, RunTimer)
        
    Loop

End Sub

 

[Bret1]

Is this what you mean?

Dim RunTimer As Date

Sub New_Copy_Over_Both_Columns()

'RunTimer = Now + TimeValue("00:05:00")
    Dim finalTime As Date, currentTime As Date
 
    RunTimer = Date + TimeSerial(8, 15, 0)
    finalTime = Date + TimeSerial(15, 15, 0)
    currentTime = Now
 
    If currentTime < RunTimer Or currentTime >= finalTime Then Exit Sub
 
    Do Until DateDiff("s", RunTimer, finalTime) = 0
        'Directly comparing was allowing an extra loop so datediff in seconds is used
        'Note both times mod 5 minutes = 0
        If RunTimer >= currentTime Then
     
            Application.OnTime RunTimer, "New_Copy_Over_Both_Columns", Schedule:=True
            'Debug.Print RunTimer
            Exit Do
         
        End If
     
        RunTimer = DateAdd("n", 5, RunTimer)
       
    Loop

End Sub

Thank you for this. I will try it tomorrow to see how it works. Question: With this code, if I open the worksheet and run the Macro before 8:15, will it then begin executing the Macro at 8:15? Or will I need to manually run the Macro at (or after 8:15)? I would like for it to still "automatically" start running the Macro at 8:15am even if I run it before 8:15.

 

[MoshiM]

Thank you for this. I will try it tomorrow to see how it works. Question: With this code, if I open the worksheet and run the Macro before 8:15, will it then begin executing the Macro at 8:15? Or will I need to manually run the Macro at (or after 8:15)? I would like for it to still "automatically" start running the Macro at 8:15am even if I run it before 8:15.

Move

If currentTime < RunTimer Or currentTime >= finalTime Then Exit Sub

below the Do Loop

 

[Bret1]

Move

If currentTime < RunTimer Or currentTime >= finalTime Then Exit Sub

below the Do Loop

Can you tell me what part of your code designates the 5 minute pause? What would I change in your code to make it 1 minute pause, or 5 seconds pause, to help me see if code is working?

 

[MoshiM]

Can you tell me what part of your code designates the 5 minute pause? What would I change in your code to make it 1 minute pause, or 5 seconds pause, to help me see if code is working?

Use this instead and view the link within the comments to find out more about the dateadd function

Dim RunTimer As Date
Sub New_Copy_Over_Both_Columns()
'RunTimer = Now + TimeValue("00:05:00")
    Dim finalTime As Date, currentTime As Date
   
    'https://learn.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/dateadd-function
    const timeInterval as long =5
    const timeIntervalType as string="n" ' n will tell datediff function to use minutes

    RunTimer = Date + TimeSerial(8, 15, 0)
    finalTime = Date + TimeSerial(15, 15, 0)
    currentTime = Now
   
    Do Until DateDiff("s", RunTimer, finalTime) = 0 or RunTimer > finalTime
        'Directly comparing was allowing an extra loop so datediff in seconds is used
       
        If RunTimer >= currentTime Then
     
            Application.OnTime RunTimer, "New_Copy_Over_Both_Columns", Schedule:=True
            'Debug.Print RunTimer
            Exit Do
         
        End If
     
        RunTimer = DateAdd(timeIntervalType, timeInterval, RunTimer) ' <<<<<<<======New DateTime to check calculated here
       
    Loop
    If currentTime < RunTimer Or currentTime >= finalTime Then Exit Sub
End Sub

 

[Bret1]

Use this instead and view the link within the comments to find out more about the dateadd function

Dim RunTimer As Date
Sub New_Copy_Over_Both_Columns()
'RunTimer = Now + TimeValue("00:05:00")
    Dim finalTime As Date, currentTime As Date
  
    'https://learn.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/dateadd-function
    const timeInterval as long =5
    const timeIntervalType as string="n" ' n will tell datediff function to use minutes

    RunTimer = Date + TimeSerial(8, 15, 0)
    finalTime = Date + TimeSerial(15, 15, 0)
    currentTime = Now
  
    Do Until DateDiff("s", RunTimer, finalTime) = 0 or RunTimer > finalTime
        'Directly comparing was allowing an extra loop so datediff in seconds is used
      
        If RunTimer >= currentTime Then
    
            Application.OnTime RunTimer, "New_Copy_Over_Both_Columns", Schedule:=True
            'Debug.Print RunTimer
            Exit Do
        
        End If
    
        RunTimer = DateAdd(timeIntervalType, timeInterval, RunTimer) ' <<<<<<<======New DateTime to check calculated here
      
    Loop
    If currentTime < RunTimer Or currentTime >= finalTime Then Exit Sub
End Sub

After I run the Macro, it does start at the designated time correctly, but it only loops 1-3 times before stopping, no matter what time I put for "finalTime"..... For my evaluations, I only changed the "n" to "s" for "seconds" and "RunTimer" and "finalTime". Thanks again for your help on this!

 

[MoshiM]

After I run the Macro, it does start at the designated time correctly, but it only loops 1-3 times before stopping, no matter what time I put for "finalTime"..... For my evaluations, I only changed the "n" to "s" for "seconds" and "RunTimer" and "finalTime". Thanks again for your help on this!

Can you post exactly what you edited them to? The following works perfectly.
I edited the time addition for clarity

Dim RunTimer As Date
Sub New_Copy_Over_Both_Columns()
'RunTimer = Now + TimeValue("00:05:00")
    Dim finalTime As Date, currentTime As Date
  
    Const hourInterval As Integer = 0, minuteInterval As Integer = 0, secondInterval As Integer = 3
   
    RunTimer = Date + TimeSerial(8, 15, 0)'8:15 AM
    finalTime = Date + TimeSerial(15, 15, 0)'3:15 PM
    currentTime = Now
  
    Do Until DateDiff("s", RunTimer, finalTime) = 0 Or RunTimer > finalTime
        'Directly comparing was allowing an extra loop so datediff in seconds is used
      
        If RunTimer >= currentTime Then
       
            Debug.Print RunTimer
           
            Application.OnTime RunTimer, "New_Copy_Over_Both_Columns", Schedule:=True
            'Debug.Print RunTimer
            Exit Do
        
        End If
    
        RunTimer = RunTimer + TimeSerial(hourInterval, minuteInterval, secondInterval) ' <<<<<<<======New DateTime to check calculated here
      
    Loop
   
    If currentTime < RunTimer Or currentTime >= finalTime Then Exit Sub

End Sub

 

[MoshiM]

Nvm its probably the last line

Dim RunTimer As Date
Sub New_Copy_Over_Both_Columns()
'RunTimer = Now + TimeValue("00:05:00")
    Dim finalTime As Date, currentTime As Date,intialRunTimer as date
 
    Const hourInterval As Integer = 0, minuteInterval As Integer = 0, secondInterval As Integer = 3
  
    intialRunTimer = Date + TimeSerial(8, 15, 0)
   runtimer=initialTimer
    finalTime = Date + TimeSerial(15, 15, 0)
    currentTime = Now
 
    Do Until DateDiff("s", RunTimer, finalTime) = 0 Or RunTimer > finalTime
        'Directly comparing was allowing an extra loop so datediff in seconds is used
     
        If RunTimer >= currentTime Then
      
            Debug.Print RunTimer
          
            Application.OnTime RunTimer, "New_Copy_Over_Both_Columns", Schedule:=True
            'Debug.Print RunTimer
            Exit Do
       
        End If
   
        RunTimer = RunTimer + TimeSerial(hourInterval, minuteInterval, secondInterval) ' <<<<<<<======New DateTime to check calculated here
     
    Loop
  
    If currentTime < intialRunTimer Or currentTime >= finalTime Then
        Exit Sub
    End If
  
End Sub

 

[Bret1]

Nvm its probably the last line

Dim RunTimer As Date
Sub New_Copy_Over_Both_Columns()
'RunTimer = Now + TimeValue("00:05:00")
    Dim finalTime As Date, currentTime As Date,intialRunTimer as date
 
    Const hourInterval As Integer = 0, minuteInterval As Integer = 0, secondInterval As Integer = 3
 
    intialRunTimer = Date + TimeSerial(8, 15, 0)
   runtimer=initialTimer
    finalTime = Date + TimeSerial(15, 15, 0)
    currentTime = Now
 
    Do Until DateDiff("s", RunTimer, finalTime) = 0 Or RunTimer > finalTime
        'Directly comparing was allowing an extra loop so datediff in seconds is used
    
        If RunTimer >= currentTime Then
     
            Debug.Print RunTimer
         
            Application.OnTime RunTimer, "New_Copy_Over_Both_Columns", Schedule:=True
            'Debug.Print RunTimer
            Exit Do
      
        End If
  
        RunTimer = RunTimer + TimeSerial(hourInterval, minuteInterval, secondInterval) ' <<<<<<<======New DateTime to check calculated here
    
    Loop
 
    If currentTime < intialRunTimer Or currentTime >= finalTime Then
        Exit Sub
    End If
 
End Sub

Thank you for your help. I'm very much a beginner, but I can't seem to get this to work. It is currently 6:05pm and I only changed the "initialRunTimer" to (18, 06, 0) and "runtimer to (18, 08, 0). I also need the ability to change the loop time from every 5 minutes to seconds (in the macro for testing purposes only). I don't see where this code designates to loop every 5 minutes.