Couple of macros are used. In then "ThisWorkbook" module, paste:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Stop execution when workbook closes
On Error Resume Next
Application.OnTime Heure, "Calcul", , False
End Sub
Private Sub Workbook_Open()
'start execution when workbook opens
Application.OnTime Now + TimeValue("00:01:00"), "Calcul"
End Sub
In module :
VB:
Public Heure As Date
Sub Calcul()
Heure = Now + TimeValue("00:01:00")
Application.OnTime Heure, "Calcul"
Range("B65536").End(xlUp).Offset(1) = [A1]
End Sub
Cell A1 will be copied every minute in column B (starting B2). Now I want this function to start at 00:08:00 but wasn't able to achieve it.
As long as the workbook can remain open, the below code:
Private Sub Workbook_Open()
'start execution when workbook opens
Application.OnTime Now + TimeValue("00:01:00"), "Calcul"
End Sub
Can be replaced with the following:
Private Sub Workbook_Open()
'start execution at 8 AM when workbook opens
If Hour(Now()) < 8 Then
' If it is before 8 AM
Application.OnTime Int(Now()) + TimeSerial(8, 0, 0), "Calcul"
Else
' Otherwise begin 8 AM the next day
Application.OnTime Int(Now()) + 1 + TimeSerial(8, 0, 0), "Calcul"
End if
End Sub
Related
VBA code for autosaving and for closing the workbook if idle is working. The problem is, Excel continues to run the code if another instance of the program was open when the code closed the workbook. I think what I need to do is to unload the workbook, but I can't figure out how. I've tried "Unload Workbook," "Unload ThisWorkbook," and "Unload ResetTimer" [the module which detects activity and starts the 35 minute timer over]. I'm getting an error that Workbook/ThisWorkbook/ResetTimer are not object that can be unloaded. I can't find a list of what objects can be unloaded.
Here is the code under ThisWorkbook
Option Explicit
Private Sub ThisWorkbook_Open()
If ThisWorkbook.ReadOnly = False Then
Application.OnTime Now + TimeValue("00:30:00"), "SaveThis"
End If
If ThisWorkbook.ReadOnly = False Then
Application.OnTime Now + TimeValue("00:35:00"), "CloseDownFile"
End If
End Sub
Private Sub ThisWorkbook_Close()
Unload ThisWorkbook
' Unload ResetTimer
End Sub
Private Sub ThisWorkbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub
Private Sub ThisWorkbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Private Sub ThisWorkbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Here is the Module:
Public CloseDownTime As Variant
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:35:00") ' change as needed
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub
Public Sub CloseDownFile()
On Error Resume Next
ThisWorkbook.Close SaveChanges:=True
Unload ThisWorkbook
End Sub
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.OnTime Now + TimeValue("00:30:00"), "SaveThis"
End Sub
Your regular module should look more like this (see below). This removes the logic from your ThisWorkbook module.
Option Explicit
Public CloseTime As Variant
Public SaveTime As Variant
Public Sub StartTimers()
StartSaveTimer
StartCloseTimer
End Sub
Public Sub CancelTimers()
CancelSaveTimer
CancelCloseTimer
End Sub
Sub StartSaveTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelSaveTimer 'remove any existing timer
SaveTime = Now + TimeValue("00:30:00")
Application.OnTime SaveTime, "SaveThis"
End Sub
Sub CancelSaveTimer()
On Error Resume Next
Application.OnTime EarliestTime:=SaveTime, Procedure:="SaveThis", Schedule:=False
On Error GoTo 0
End Sub
Sub StartCloseTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelCloseTimer 'remove any existing timer
CloseTime = Now + TimeValue("00:35:00")
Application.OnTime CloseTime, "CloseThis"
End Sub
Sub CancelCloseTimer()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, Procedure:="CloseThis", Schedule:=False
On Error GoTo 0
End Sub
Public Sub CloseThis()
On Error Resume Next
CancelTimers
ThisWorkbook.Close SaveChanges:=True
End Sub
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
StartSaveTimer
End Sub
Here is the corrected code to save every 30 minutes and to close after 35 minutes of no use. Thank you to #TimWilliams for all of the help!
Code under ThisWorkbook:
Option Explicit
Private Sub Workbook_Open()
Call StartTimers
End Sub
Private Sub Workbook_Close()
CancelTimers
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
CancelCloseTimer
StartCloseTimer
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
CancelCloseTimer
StartCloseTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
CancelCloseTimer
StartCloseTimer
End Sub
Code for Module:
Option Explicit
Public CloseTime As Variant
Public SaveTime As Variant
Public Sub StartTimers()
StartSaveTimer
StartCloseTimer
End Sub
Public Sub CancelTimers()
CancelSaveTimer
CancelCloseTimer
End Sub
Sub StartSaveTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelSaveTimer 'remove any existing timer
SaveTime = Now + TimeValue("00:30:00") 'save frequency, change as needed
Application.OnTime SaveTime, "SaveThis"
End Sub
Sub CancelSaveTimer()
On Error Resume Next
Application.OnTime EarliestTime:=SaveTime, Procedure:="SaveThis", Schedule:=False
On Error GoTo 0
End Sub
Sub StartCloseTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelCloseTimer 'remove any existing timer
CloseTime = Now + TimeValue("00:35:00") 'idle time before closing, change as needed
Application.OnTime CloseTime, "CloseThis"
End Sub
Sub CancelCloseTimer()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, Procedure:="CloseThis", Schedule:=False
On Error GoTo 0
End Sub
Public Sub CloseThis()
On Error Resume Next
CancelTimers
ThisWorkbook.Close SaveChanges:=True
End Sub
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
StartSaveTimer
End Sub
I'm building a form that can take the values from the clipboard and auto fill itself.
In order to get the values I use application.ontime to run a macro every two seconds and read the clipboard. The start is done in userform initialize.
That works fine.
Sub Userform_Initialize()
On Error Resume Next
fireTime = Now + TimeValue("00:00:02")
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=True
On Error GoTo 0
End Sub
If I close the userform I added a queryclose to make sure the copy macro stops:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=False
End Sub
Works fine also.
The actual macro is this:
Public fireTime As Date
Sub copy()
On Error GoTo ErrHandler
Dim oData As New DataObject
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
strPaste = DataObj.GetText(1)
Row1 = Split(strPaste, vbNewLine)(0)
col = Split(Row1, vbTab)
If UBound(Split(col(14), "-")) = 2 Then
If Len(col(0)) = 7 Then
If Left(col(3), 4) = "4600" Then
oData.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take in the clipboard to empty it
UF_RegistreraVM.TB_LevNr.Text = col(0)
Levnr = col(0)
' ... and so on..
'Line below does not work
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=False
Exit Sub
End If
End If
End If
ErrHandler:
On Error Resume Next
fireTime = Now + TimeValue("00:00:02")
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=True
On Error GoTo 0
End Sub
And the only line that does not work is when I set application.ontime to false in the nested ifs.
That line is the same as the one in queryclose, but it doesn't work here.
When I debug the code errors on that line and due to On Error GoTo ErrHandler it jums down to ErrHandler and sets a new time to run the macro.
What is the issue that with the code, why can't I turn of the ontime inside the ifs?
Just want to ask if why do I keep receiving this error?
Run-time error '1004': Method 'OnTime' of object'_Application' failed
So, I'm trying to close my workbook but whenever I'm doing it, the error shows. The highlighted line after clicking the Debug button is Application.OnTime timeCheck, "SaveThis", , False in the Workbook_BeforeClose sub. What seems to be the problem here?
Private Sub Workbook_Open() 'place in ThisWorkbook
timeCheck = Now + TimeValue("00:15:00")
Application.OnTime timeCheck, "SaveThis"
End Sub
Sub SaveThis() 'place in Module
timeCheck = Now + TimeValue("00:15:00")
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.OnTime timeCheck, "SaveThis"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'place in ThisWorkbook
Application.OnTime timeCheck, "SaveThis", , False
End Sub
It seems to me that you are trying to schedule a call to SaveThis() in the future, right when the application is about to close. Why would you want to do that?, if the error never happened, then how will you guarantee that the call happens when the workbook is already closed?
If what you meant to do is save the workbook before closing the workbook, then you will need to change your code as follows:
Private Sub Workbook_Open() 'place in ThisWorkbook
timeCheck = Now + TimeValue("00:15:00")
Application.OnTime timeCheck, "SaveThis"
End Sub
Sub SaveThis()
timeCheck = Now + TimeValue("00:15:00")
SaveRightNow ' This is a new sub that you will need to add
Application.OnTime timeCheck, "SaveThis"
End Sub
Sub SaveRightNow()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'place in ThisWorkbook
SaveRightNow ' Saves the workbook without having to schedule a call in the future
End Sub
Module1:
Sub TimeCheck()
Dim ValueTime As Date
Dim SysTime As Date
ValueTime = Sheets("mylinks").Range("A22").Value
SysTime = Now()
If TimeValue(ValueTime) >= TimeValue(SysTime) Then
MsgBox ("Check the Aplication")
End If
End Sub
Private Sub Workbook_open()
alertTime = Now + TimeValue("00:00:05")
Application.OnTime alertTime, "Timecheck"
End Sub
The above code is not working. Can someone help me with this?
I have a button assigned to the StopRecordingData sub to cancel both subs and it doesn't. The schedule False doesn't seem to cancel the scheduled subs in que.
Dim NextTime As Double
Sub RecordData()
Dim Interval As Double
Dim cel As Range, Capture As Range
Application.StatusBar = "Recording Started"
Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row
of data
With Worksheets("Journal") 'Record the data on this worksheet
Set cel = .Range("A2") 'First timestamp goes here
Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
cel.Value = Now
cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
End With
NextTime = Now + TimeValue("00:01:00")
Application.OnTime NextTime, "CloseWB"
End Sub
Sub CloseWB()
Application.OnTime NextTime, "RecordData"
ThisWorkbook.Close True
End Sub
Sub StopRecordingData()
Application.StatusBar = "Recording Stopped"
Application.OnTime NextTime, "RecordData", False
Application.OnTime NextTime, "CloseWB", False
End Sub
You must either
use 2 commas in the end or
full method definition of OnTime method
as the syntax of OnTime method has 4 arguments and last 2 are optional.
Application.OnTime EarliestTime, Procedure, [LatestTime],
[Schedule]
Also, for time related variables, prefer DATE over DOUBLE. Hence use this at the top.
Dim NextTime as Date
Sub StopRecordingData()
Application.StatusBar = "Recording Stopped"
Application.OnTime NextTime, "RecordData",, False
Application.OnTime NextTime, "CloseWB",, False
End Sub
Sub StopRecordingData()
Application.StatusBar = "Recording Stopped"
Application.OnTime EarliestTime:=NextTime, Procedure:="RecordData", Schedule:=False
Application.OnTime EarliestTime:=NextTime, Procedure:="CloseWB", Schedule:=False
End Sub