Excel file keeps opening even Application.On Time schedule is off - excel

Question

I hope someone can help me about problem that i have.
I created workbook than will on opening start few macros:
Refresh_time - runs every second to update time counter
Save_it - saves file on every 30 minutes
Order - runs marco Save_order at specific time, 02, 10 and 18 hours
Also there is few marcos which will close file if there is no activity for 10 minutes.
In both cases, if file is closed due to inactivity or closed manualy, it keeps opening by it self.
Do anybody have idea where i have made mistake?
In ThisWorkbook
Private Sub Workbook_Open()
Refresh_time
Save_it
Order
TimeSetting
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Save
Stop_
TimeStop
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
TimeStop
TimeSetting
End Sub
In Module1
Public dTimeB, dTimeS, dTimeT1, dTimeT2, dTimeT3, CloseTime As Date
Sub Stop_()
Application.OnTime dTimeB, "Refresh_time", , False
Application.OnTime dTimeS, "Save_it", , False
Application.OnTime dTimeT1, "Save_order", , False
Application.OnTime dTimeT2, "Save_order", , False
Application.OnTime dTimeT3, "Save_order", , False
End Sub
Sub TimeSetting()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=False
On Error GoTo 0
CloseTime = Now() + TimeValue("00:03:00")
Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
ActiveWorkbook.Close Savechanges:=True
End Sub
Sub Refresh_time()
Dim Smena_1, Smena_2, Smena_3 As Date
On Error Resume Next
Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=False
On Error GoTo 0
dTimeB = Now() + TimeValue("00:00:01")
Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=True
Smena_1 = Date + TimeValue("10:00:00")
Smena_2 = Date + TimeValue("18:00:00")
Smena_3 = Date + 1 + TimeValue("02:00:00")
vreme = Date + Time
If vreme < Smena_1 Then
Y = Smena_1 - vreme
Else
If vreme < Smena_2 Then
Y = Smena_2 - vreme
Else
Y = Smena_3 - vreme
End If
End If
Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Pocetna").Vreme_porucivanja.Value = Format(Y, "hh:mm:ss")
Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Pocetna").Za_porucivanje.Value = Application.CountA(Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Za porucivanje").Range("A:A")) - 1
End Sub
Sub Save_it()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
On Error Resume Next
Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=False
On Error GoTo 0
dTimeS = Now() + TimeValue("00:10:00")
Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=True
End Sub
Sub Order()
On Error Resume Next
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
On Error GoTo 0
dTimeT1 = TimeValue("02:00:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
On Error Resume Next
Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=False
On Error GoTo 0
dTimeT2 = TimeValue("10:00:00")
Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=True
On Error Resume Next
Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=False
On Error GoTo 0
dTimeT3 = TimeValue("18:00:00")
Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=True
End Sub
I did as you suggested, but still is not ok (code is updated). Also, when Order macro run, lets say at 10:00, it runs 3 times. Can you help me with this little more?

Answer 1

You are doing most things correct with application.ontime. But there is one thing you should add. Before setting a new ontime delete the previous.
As an example:
dTimeT1 = now() + TimeValue("00:10:00")
Application.OnTime dTimeT1, "Save_order"
I would change that too:
on error resume next ' in case dTimeT1 is not set
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
on error goto 0
dTimeT1 = now() + TimeValue("00:10:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
Because if dTimeT1 is a time in the future you could end up with two application.ontimes set but you can't remove the previous because your variable has been changed.
So always clear the previous one then set a new. This issue occurs when you run the macro manually.
Specific to your question:
I'm not sure about your stop function. Why do you first set a schedule then remove it?
Why not just?
Sub Stop_()
on error resume next
Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=False
Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=False
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=False
Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=False
on error goto 0
End Sub
As an example of how this is an issue:
' set this to some time in future
dTimeT1 = TimeValue("12:00:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
' we now set a new time
dTimeT1 = TimeValue("12:05:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
' we simulate a close of the workbook which should remove the schedule
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=false
But this code will run at 12:00 anyways because you set two schedules but only removes one.