OnTime statements runs only once despite being called multiple times during the day

mysticmario

Active Member
Joined
Nov 10, 2021
Messages
323
Office Version
  1. 365
Platform
  1. Windows
Hi, I have new issue.
I made an hour counter which I want to sue to track time of the employees.
I have this workbook open event where it saves the data multiple times during the day.
I set the clocker on a tablet with windows. The tablet always stays awake, never disconnects form the web and It is always power supplied.
The call clock event runs a macro that constantly updates worksheet cell with current time using =Now+TimeValue(00:00:01)(simplified code)
So in theory the excel is constantly being "worked on". However when i clock in the first ontime event at 8:15 runs fine but the other on time never run.
I tested it previously with the times beign brougth close together and it was workign fine, the problem happens when the ontime events are far apart.\
Here's the code:
VBA Code:
Private Sub Workbook_Open()
Application.DisplayFullScreen = True

Call clock

    Application.DisplayAlerts = False
    Sheets("MAIN").Select
    Sheets("Aktualnie zalogowani").Select
    Sheets("Aktualnie zalogowani").Copy
    ChDir "C:\listy obecnosci"
    ActiveWorkbook.SaveAs Filename:= _
        ("C:\listy obecnosci\Lista obecności" & Format(Now(), "DD-MMM-YYYY-HH-MM") & ".xlsx"), FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close savechanges = False
    Sheets("MAIN").Select
    Application.DisplayAlerts = True
Application.OnTime TimeValue("8:15:00"), "WorkbookSave"
Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
Application.OnTime TimeValue("23:58:00"), "WorkbookSave"
Application.OnTime TimeValue("23:59:00"), "WorksheetClear"
    
            
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
As you have found only one application.ontime trigger is saved. This is to be expected. What you have to do is trigger the 18:00 and 23:58 workbooksave trigger from the workbooksave subroutine.
I.e when workbooksave runs, you set the next trigger so change these 4 lines:
VBA Code:
Application.OnTime TimeValue("8:15:00"), "WorkbookSave"
Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
Application.OnTime TimeValue("23:58:00"), "WorkbookSave"
Application.OnTime TimeValue("23:59:00"), "WorksheetClear"
to
VBA Code:
Application.OnTime TimeValue("8:15:00"), "WorkbookSave"
'Application.OnTime TimeValue("18:00:00"), "WorkbookSave"'  ' commented out
'Application.OnTime TimeValue("23:58:00"), "WorkbookSave"   ' commented out
'Application.OnTime TimeValue("23:59:00"), "WorksheetClear"  ' commented out
the at the end of the workbooksave subroutien add this code:
VBA Code:
If (Time() > TimeValue("8:15:00")) And (Time() < TimeValue("18:00:00")) Then
   Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("18:00:00")) And (Time() < TimeValue("23:58:00")) Then
   Application.OnTime TimeValue("25:58:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("23:58:00")) And (Time() < TimeValue("23:59:00")) Then
   Application.OnTime TimeValue("25:59:00"), "WorksheetClear"
 End If
 
Upvote 0
As you have found only one application.ontime trigger is saved. This is to be expected. What you have to do is trigger the 18:00 and 23:58 workbooksave trigger from the workbooksave subroutine.
I.e when workbooksave runs, you set the next trigger so change these 4 lines:
VBA Code:
Application.OnTime TimeValue("8:15:00"), "WorkbookSave"
Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
Application.OnTime TimeValue("23:58:00"), "WorkbookSave"
Application.OnTime TimeValue("23:59:00"), "WorksheetClear"
to
VBA Code:
Application.OnTime TimeValue("8:15:00"), "WorkbookSave"
'Application.OnTime TimeValue("18:00:00"), "WorkbookSave"'  ' commented out
'Application.OnTime TimeValue("23:58:00"), "WorkbookSave"   ' commented out
'Application.OnTime TimeValue("23:59:00"), "WorksheetClear"  ' commented out
the at the end of the workbooksave subroutien add this code:
VBA Code:
If (Time() > TimeValue("8:15:00")) And (Time() < TimeValue("18:00:00")) Then
   Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("18:00:00")) And (Time() < TimeValue("23:58:00")) Then
   Application.OnTime TimeValue("25:58:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("23:58:00")) And (Time() < TimeValue("23:59:00")) Then
   Application.OnTime TimeValue("25:59:00"), "WorksheetClear"
 End If
Like this:?
VBA Code:
Private Sub Workbook_Open()
Application.DisplayFullScreen = True

Call clock

    Application.DisplayAlerts = False
    Sheets("MAIN").Select
    Sheets("Aktualnie zalogowani").Select
    Sheets("Aktualnie zalogowani").Copy
    ChDir "C:\listy obecnosci"
    ActiveWorkbook.SaveAs Filename:= _
        ("C:\listy obecnosci\Lista obecności" & Format(Now(), "DD-MMM-YYYY-HH-MM") & ".xlsx"), FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close savechanges = False
    Sheets("MAIN").Select
    Application.DisplayAlerts = True
Application.OnTime TimeValue("8:15:00"), "WorkbookSave"
--------------------------
VBA Code:
Sub WorkbookSave()

    Application.DisplayAlerts = False
    Sheets("MAIN").Select
    Sheets("Aktualnie zalogowani").Select
    Sheets("Aktualnie zalogowani").Copy
    ChDir "C:\Users\Shelby\Documents\Listy obecności"
    ActiveWorkbook.SaveAs Filename:= _
        ("C:\Users\Shelby\Documents\Listy obecności\Lista obecności" & Format(Now(), "DD-MMM-YYYY-hh-mm") & ".xlsx"), FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close savechanges = False
    Sheets("MAIN").Select
    Application.DisplayAlerts = True
    
    If (Time() > TimeValue("8:15:00")) And (Time() < TimeValue("18:00:00")) Then
   Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("18:00:00")) And (Time() < TimeValue("23:58:00")) Then
   Application.OnTime TimeValue("25:58:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("23:58:00")) And (Time() < TimeValue("23:59:00")) Then
   Application.OnTime TimeValue("25:59:00"), "WorksheetClear"
 End If
    
End Sub
 
Upvote 0
Maybe my previous code would work if I activate a cell from time to time inbetween the saves?
 
Upvote 0
you could try changing :
VBA Code:
If (Time() > TimeValue("8:15:00")) And (Time() < TimeValue("18:00:00")) Then
   Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("18:00:00")) And (Time() < TimeValue("23:58:00")) Then
   Application.OnTime TimeValue("25:58:00"), "WorkbookSave"
 End If
 If (Time() > TimeValue("23:58:00")) And (Time() < TimeValue("23:59:00")) Then
   Application.OnTime TimeValue("25:59:00"), "WorksheetClear"
 End If
to:
VBA Code:
If (Time() >= TimeValue("8:15:00")) And (Time() < TimeValue("18:00:00")) Then
   Application.OnTime TimeValue("18:00:00"), "WorkbookSave"
 End If
 If (Time() >= TimeValue("18:00:00")) And (Time() < TimeValue("23:58:00")) Then
   Application.OnTime TimeValue("25:58:00"), "WorkbookSave"
 End If
 If (Time() >= TimeValue("23:58:00")) And (Time() < TimeValue("23:59:00")) Then
   Application.OnTime TimeValue("25:59:00"), "WorksheetClear"
 End If
The other thing I suggest to put a msgbox or a debug print at the beginning of the workbook save routine to see if it ever gets called. then save the file and reopen it. you then shoujld be able to see where the problem is.
 
Upvote 0
Still battling this issue my code for This_workbook looks like this:
VBA Code:
Private Sub Workbook_Open()
Application.DisplayFullScreen = True




    Application.DisplayAlerts = False
    Sheets("MAIN").Select
    Sheets("Aktualnie zalogowani").Select
    Sheets("Aktualnie zalogowani").Copy
    ChDir "C:\listy obecnosci"
    ActiveWorkbook.SaveAs Filename:= _
        ("C:\listy obecnosci\Lista obecności" & Format(Now(), "DD-MMM-YYYY") & ".xlsm"), FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWindow.Close savechanges = False
    Sheets("MAIN").Select
    Application.DisplayAlerts = True
Application.OnTime TimeValue("23:55:00"), "WorkbookSave"
    
            
End Sub

So I moved on to only single save late at night.
WorbookSave sub routine has been slightly updated.
Code:
Sub WorkbookSave()

    Application.DisplayAlerts = False
    Sheets("MAIN").Select
    Sheets("Aktualnie zalogowani").Select
    Sheets("Aktualnie zalogowani").Copy
    ChDir "C:\listy obecnosci"
    ActiveWorkbook.SaveAs Filename:= _
        ("C:\listy obecnosci\Lista obecności" & Format(Now(), "DD-MMM-YYYY") & ".xlsm"), FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWindow.Close savechanges = False
    Sheets("Aktualnie zalogowani").Select
        Range("A1:E21").Select
    Range("A1:E21").Copy
    Range("A1:P1").Insert Shift:=xlDown
    Range("C2:D21").Select
        Range("C2:D21").ClearContents
    Sheets("MAIN").Select
    Application.DisplayAlerts = True
    ThisWorkbook.Save
    Application.Workbooks.Open (ThisWorkbook.FullName)
    
    
End Sub


So to make sure it works I deleted clock subroutine which was updating the one cell in workbook every second providing clock for the application and "refresh"
But I figured that it may cause issues with ontime.
I also included reopening of the workbook, to refresh it this way.
However the issue stayed. Sometimes the sub routine works sometimes not. It may run for 2 days and then it wont. Next time it will work on friday but when i come back to work on Monday it doesn't.

Does anyone have an idea how to make it work, or knows any workaround?
before the questions pops. I run this excel sheet on a windows tablet which is always on, always powered supply and never goes to sleep.
 
Upvote 0
I am really tempted to put Application.Workbooks.Open (ThisWorkbook.FullName) to be called when I clock out of work with this app, but it ruins the whole notion of being automated, and I am also worried if I clock out on Friday it will break down during the weekend... So is application.Ontime so unreliable that you cant make it run all the time? Maybe I should create some sort of loop. I can provide a whole file here, but it has employee names so it sort of violates their privacy but I am desperate at this point.
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,109
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top