I have a code that works fine until I added a MsgBox confirmation if the user wants to end the timer. The userform just shows a timer starting zero everytime a user starts a task.
I tried replacing "myTimer", , False -> "myTimer", , True but the timer just continues to increment in the background.
-----Userform-----
Private Sub UserForm_Initialize()
Call myTimer
StartTime = Timer
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _CloseMode As Integer)
If MsgBox("Are you sure to End Time?", vbYesNo) = vbYes Then
myTimer_Cancel
Else
Cancel = True
End If
End Sub
-----Module-----
Option Explicit
Public StartTime As Single
Public Sub myTimer()
Dim elapsedtime As Single
elapsedtime = Timer - StartTime
UserForm2.Label2.caption = Format(CDate(elapsedtime / 86400), "hh:nn:ss")
Application.OnTime Now + timeValue("00:00:01"), "myTimer"
End Sub
Public Sub myTimer_Cancel()
Application.OnTime Now + timeValue("00:00:01"), "myTimer", , False
End Sub
When you cancel a timer you must use the same exact time you used when you set it, so:
-----Userform-----
Private Sub UserForm_Initialize()
Call myTimer
StartTime = Timer
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _CloseMode As Integer)
If MsgBox("Are you sure to End Time?", vbYesNo) = vbYes Then
myTimer_Cancel
Else
Cancel = True
End If
End Sub
-----Module-----
Option Explicit
Public StartTime As Single
Public NextRun ' << store next run time
Public Sub myTimer()
Dim elapsedtime As Single
elapsedtime = Timer - StartTime
UserForm2.Label2.caption = Format(CDate(elapsedtime / 86400), "hh:nn:ss")
NextRun = Now + timeValue("00:00:01")
Application.OnTime NextRun, "myTimer"
End Sub
Public Sub myTimer_Cancel()
Application.OnTime NextRun, "myTimer", , False
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
This is the timer codes
Sub StartTimer()
Application.OnTime Now + TimeValue("00:00:01"), _
"Decrement_Count_By_1"
End Sub
Then, the countdown
Sub Decrement_Count_By_1()
StartTimer
Range("Z1").Value = Range("Z1").Value - TimeValue("00:00:01")
UserForm5.Label7.Caption = Format(Range("Z1").Value, "hh:mm:ss")
If Range("Z1").Value = "00:00::01" Then
End If
On Error Resume Next
If Range("Z1").Value = 0 Then
End If
End Sub
Sub resettimer()
If Range("Z1").Value = 0 Then
Range("Z1").Value = ("00:01:00")
End If
End Sub
Then, how to make userform close when the timer ends? Please help me, thankyouu
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
I've got 5 UserForms and some of them activate depending on what the input of the first UserForm is.
The first UserForm code is below.
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
WsName = "CAT"
Unload Me
End If
End Sub
Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then
WsName = "DOG"
Unload Me
End If
End Sub
Private Sub OptionButton3_Click()
If OptionButton3.Value = True Then
WsName = "CATDOG"
Unload Me
End If
End Sub
Private Sub OptionButton4_Click()
If OptionButton4.Value = True Then
WsName = "DOGCAT"
Unload Me
End If
End Sub
Private Sub UserForm_Initialize()
Me.StartUpPosition = 0
Me.Top = Application.Top + 250
Me.Left = Application.Left + Application.Width - Me.Width - 600
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
End
End Sub
When I press the Red "X" to end the entire module that calls the UserForm the module is exited and I am happy. When I press one of the options on the userform like OptionButton1.Value = True then the code also exits the module and I am sad. What am I doing wrong? I would like for the user to be able to press the Red "X" at any point in any UserForm to close out the Module and break out of the code.
The answer to this question was
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If
OptionButton1.Value = False And OptionButton2.Value = False OptionButton3.Value =
False And OptionButton4.Value = False Then
End
End If
End Sub