Application.OnTime Not Stopping...

[burns14hs]

I have been around the interwebs all day and found multiple posts on multiple forums about this but I cannot get it to work correctly no matter what I've tried. Can someone please tell me why my timer never stops and restarts? I start the timer on workbook open and no matter how many different macros i run that begin with stoptimer and end with starttimer, the workbook always shuts down exactly 15 minutes after original open. What am I doing wrong?

Public RunWhen As Double

Public Sub StartTimer()
On Error Resume Next
RunWhen = Now + TimeValue("00:15:00") ' hh:mm:ss
Application.OnTime EarliestTime:=RunWhen, Procedure:="CloseDownFile", Schedule:=True

End Sub

Public Sub CloseDownFile()

StopTimer

Dim bCancel As Boolean
Application.run "ThisWorkbook.Workbook_BeforeClose", bCancel

On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=False
End Sub

Public Sub StopTimer()

On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="CloseDownFile", Schedule:=False

End Sub

 

[burns14hs]

I should also mention that I have tested this with another blank excel sheet open in the background and when operating any macro that has a stop and then a start, application.OnTime is actually starting again, it just appears to not be stopping anything. I have verified this by opening the workbook (starts the timer) and then 5 minutes later stopped and started the timer and then 5 minutes later stopped and started the timer again. If this was working right, this should have only shut down 15 minutes after the last start but it actually shut down 5 minutes after the last start (15 minutes after workbook open). Then, with another blank Excel book open in the background, the program reopened itself 5 minutes later and then immediately shut down, and then did the same 5 minutes later. It appears as though whatever is starting it keeps creating multiples but it never gets stopped.

 

[Jaafar Tribak]

I don't see any line of code that resatrts your timer .

 

[burns14hs]

Ok, so in a regular module I have what is posted above - I'll repost here:

Public RunWhen As Double

--------------------------------------------------------------------
Public Sub StartTimer()
On Error Resume Next
RunWhen = Now + TimeValue("00:15:00") ' hh:mm:ss
Application.OnTime EarliestTime:=RunWhen, Procedure:="CloseDownFile", Schedule:=True

End Sub

--------------------------------------------------------------------------

Public Sub CloseDownFile()

StopTimer

Dim bCancel As Boolean
Application.run "ThisWorkbook.Workbook_BeforeClose", bCancel

On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=False
End Sub

--------------------------------------------------------------------------------------
Public Sub StopTimer()

On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="CloseDownFile", Schedule:=False

End Sub

and then in ThisWorkbook I have:

Private Sub Workbook_Open()
StopTimer
StartTimer
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
StopTimer
StartTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
StopTimer
StartTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
StopTimer
StartTimer
End Sub

That should pretty much take care of anytime anybody does anything in the workbook.

Regardless, I cannot get the timer to even stop, so the stopping is definitely the problem. Even if I open the workbook and immediately manually run StopTimer and do nothing, the workbook still closes in 15 minutes. As evidenced by leaving a second instance of Excel open in the background, I have no problem running new instances of StartTimer as I have verified the workbook opening itself just to close in specified intervals after manually running the StartTimer Sub.

 

[GTO]

Hello,

I am not understanding why we are calling Workbook_BeforeClose ? Could you show us BeforeClose as well?

Mark

 

[redridinghood74]

I started using OnTime today , even though i have a break error & choose "end" OnTime continues.
I'm not trying to hijack this post, so i'll be brief.

In my main UserForm_Initialize

Application.OnTime Now + TimeValue("00:01:00"), "AutoSave"

In a module

Sub AutoSave() 
Application.OnTime Now + TimeValue("00:01:00"), "AutoSave"
saveMSG.Show
End Sub

In the sub userform saveMSG

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Application.Wait (Now + TimeValue("0:00:05"))
'ActiveWorkbook.Save
Application.ScreenUpdating = True
Unload Me
End Sub

 

[burns14hs]

Hello,

I am not understanding why we are calling Workbook_BeforeClose ? Could you show us BeforeClose as well?

Mark

Sure no problem. The workbook close hides everything except a Home page basically and does some saving.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Step 1: Declare your variables
Dim ws As Worksheet
'Step 2: Unhide the Starting Sheet
Sheets("Home").Visible = xlSheetVisible
'Step 3: Start looping through all worksheets
For Each ws In ThisWorkbook.Worksheets
'Step 4: Check each worksheet name
If ws.Name <> "Home" Then
'Step 5: Hide the sheet
ws.Visible = xlVeryHidden
End If
'Step 6: Loop to next worksheet
Next ws
Application.ScreenUpdating = True

Range("A1").Select

StopTimer

ThisWorkbook.Save

Application.DisplayAlerts = True

End Sub

 

[redridinghood74]

It is my belief that the macro calling itself is a endless loop residing in memory, so i am guessing in my example is to call the next instance from the saveMSG userform, so in steps main-->macro-->subform , subform-->macro-->subform-->macro--> etc
So each step is reliant on the previous.

 

[GTO]

Sure no problem. The workbook close hides everything except a Home page basically and does some saving.

Okay, I shortened BeforeClose for my example, but generally, try:

Standard Module:

Option Explicit
  
'Alter to suite or change parameter values in TimeSerial()
Public Const ADD_SECONDS As Long = 15
  
Public RunWhen As Date '<---I believe .OnTime expects a Date/Time
  
Public Sub StartTimer()
  
  RunWhen = Now + TimeSerial(0, 0, ADD_SECONDS)
  Application.OnTime EarliestTime:=RunWhen, Procedure:="CloseDownFile", Schedule:=True
  
  'for testing/visual que only.  Remove this call and procedure after testing, as
  'using Timer this way is expensive and will booger-up if run slightly shy of
  'midnight (since Timer resets).
  StatBarUpdate
  
End Sub
  
Public Sub CloseDownFile()
  
  'We already have a StopTimer call in BeforeClose
  'StopTimer
  
  Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
  ThisWorkbook.Close SaveChanges:=False
  
End Sub
  
Public Sub StopTimer()
  
  'I removed all other 'On Error Resume Next' occurrences.  Except where needed to
  'handle an expected error, Resume Next masks problems and makes finding bugs in
  'your code incredibly hard.
  On Error Resume Next
  Application.OnTime EarliestTime:=RunWhen, Procedure:="CloseDownFile", Schedule:=False
  On Error GoTo 0
  
End Sub
  
Public Sub StatBarUpdate()
Dim n As Long
Dim lLimit As Long


  Application.StatusBar = "0"
  
  n = Timer
  lLimit = n + ADD_SECONDS
  
  Do While n < lLimit
    If n + 1 <= Timer Then
      n = Timer
      If IsNumeric(Application.StatusBar) Then
        Application.StatusBar = CLng(Application.StatusBar) + 1
      End If
      DoEvents
    End If
  Loop
  
  Application.StatusBar = "0"
  
End Sub

ThisWorkbook Module:

Option Explicit
  
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  
  'for brevity's sake
  StopTimer
  ThisWorkbook.Save
End Sub
  
Private Sub Workbook_Open()
  StopTimer
  StartTimer
End Sub
  
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
  StopTimer
  StartTimer
End Sub
  
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  StopTimer
  StartTimer
End Sub
  
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  StopTimer
  StartTimer
End Sub

Does that help?

Mark

 

[burns14hs]

Thanks for the suggestion, Mark. I will add this in later when I have a chance to play with the workbook and let you know the outcome.