CODEWITHSUNDEEP
excelvba
Moment Hood
Moment Hood

Reputation: 29

Run 1st macro every hour at 14,17,44,47 min and 2nd macro 22,52 min

Here i have my terrible code, the problem also is 25% Cpu usage when it runs and waits..

    Public StopRunning As Boolean
Sub somebutton_click()
    StopRunning = True
End Sub
Sub AutoOn()

  Application.DisplayAlerts = False
  Application.Wait (Now + TimeValue("00:14:00"))
  Call Wholeshort
  Application.Wait (Now + TimeValue("00:03:00"))
  Call Wholeshort
  Application.Wait (Now + TimeValue("00:05:00"))
  Call Whole
  Application.Wait (Now + TimeValue("00:22:00"))
  Call Wholeshort
  Application.Wait (Now + TimeValue("00:03:00"))
  Call Wholeshort
  Application.Wait (Now + TimeValue("00:05:00"))
  Call Whole
  Application.DisplayAlerts = True

  If Not StopRunning Then Application.OnTime Now + TimeValue("00:08:00"), "AutoOn"

End Sub

i would like to run Macro1 every hour at xx:14,xx:17,xx:44,xx:47 minutes and Macro2 every hour at xx:22,xx:52 minutes and somehow to stop that sub by button. So when i start sub at 14:55, it will start to run 15:14,15:17,15:22 .... infinetly but can be stopped by button (how do i assign a button shortcut to stop like ctrl+x)

Is there a more efficient way to code this, and that i can start this any time, not adjust waiting minutes every time depending when i start this, i need to run this same times every hour as i wrote..

Thank you!

Upvotes: 1

Views: 90

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Try this approach, please:

  1. Create two variables at module level (on top of it, in the declarations area):
    Private StopRunning as boolean, wCount as long
  1. All cycle can be start from the Workbook_Open() event, or from any other Sub:
    Private Sub Workbook_Open()
       Application.OnTime Now + TimeValue("00:14:00"), "Wholeshort"
    End Sub
  1. Then, in the module with declarations described at item 1, the next two sets of code lines must append your existing subs with their specific names:
    Private Sub Wholeshort()
      'existing procedure code...
      '....
      wCount = wCount + 1
      If Not StopRunning Then
        If wCount Mod 2 = 0 Then
            'second time (even) it calls Whole:
            Application.OnTime Now + TimeValue("00:02:00"), "Whole"
            wCount = 0
        Else
            'first time (odd) it calls itself
            Application.OnTime Now + TimeValue("00:03:00"), "Wholeshort"
        End If
      End If
    End Sub
    Private Sub Whole()
      'existing procedure code...
      '....
      If Not StopRunning Then Application.OnTime Now + TimeValue("00:22:00"), "Wholeshort"
    End Sub

In order to stop the next OnTime call, you can use your procedure:

Sub somebutton_click()
    StopRunning = True
End Sub

Upvotes: 2

Related Questions