I have a stopwatch with a start/stop/clear button that posts the time to other cells in my spreadsheet. I want to add a pause button to allow users to pause and resume the timer where they left off, but it kept resuming and adding the time passed in the interim to the total. For example, I hit start and wait 5 minutes, then click pause at 5:00. I wait 2 more minutes, then click resume, and the timer picks back up at 7:00, 7:01, 7:02, etc. How do I create an effective pause/resume button and tell excel not to include the time passed when it resumes counting?
Dim NextTick As Date, t As Date
Sub StartStopWatch()
t = Time
Call StartTimer
End Sub
Sub StartTimer()
NextTick = Time + TimeValue("00:00:01")
Range("M1").Value = Format(NextTick - t - TimeValue("00:00:01"), "hh:mm:ss")
Application.OnTime NextTick, "StartTimer"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False
End Sub
Sub ResetTimer()
Range("M1").ClearContents
Range("N1").ClearContents
Range("L2").ClearContents
End Sub
Sub PauseButton()
If Range("L2").Value = "" Then
Range("L2").Value = "Paused"
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False
Else
Range("L2").ClearContents
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=True
End If
End Sub
I think like this
Public blResume As Boolean
Dim NextTick As Date, t As Date
Sub StartStopWatch()
t = Time
Call StartTimer
End Sub
Sub StartTimer()
NextTick = Time + TimeValue("00:00:01")
Range("M1").Value = Format(NextTick - t - TimeValue("00:00:01"), "hh:mm:ss")
If blResume = False Then Exit Sub
Application.OnTime NextTick, "StartTimer"
End Sub
Sub Pause()
blResume = False
End Sub
Sub myResume()
blResume = True
StartTimer
End Sub
Related
I've got three Subs in Module: runClock, startClock and stopClock.
runClock is showing a clock that is updated every 5 seconds.
startClock is used to start the clock and is called from Sub Workbook_Open.
stopClock - is used to stop the clock and is called from Sub Workbook_BeforeClose.
However, when ever I close the workbook, it reopens automatically and the clock continues to run. I've checked the value of ClockOn and it's set to FALSE after the Workbook_BeforeClose is executed. I think that that issue has to do with Application.OnTime, but don't know how to fix it.
This Code is in Module:
Global ClockOn As Boolean
Sub runClock()
With Range("A1")
.Value = Now()
.NumberFormat = "hh:mm:ss"
If ClockOn = True Then
Application.OnTime Now + TimeSerial(0, 0, 5), "runClock"
End If
End With
End Sub
Sub startClock()
ClockOn = True
runClock
End Sub
Sub stopClock()
ClockOn = False
End Sub
This Code is in ThisWorkbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
stopClock
ActiveWorkbook.Save
End Sub
Private Sub Workbook_Open()
startClock
End Sub
This seems to be happening because the times resulting from Application.OnTime are not the same. The initial call time should be saved as a variable and then referenced in the subs. See this solution.
https://www.ozgrid.com/forum/forum/help-forums/excel-general/131658-timer-reopens-workbook-when-closed
Found a solution in http://www.cpearson.com/excel/OnTime.aspx
I've changed my sub stopClock so now it includes the following code:
RunWhen = Now + timeserial(0, 0, 5)
Application.OnTime earliestTime:=RunWhen, Procedure:="startClock", Schedule:=False
This stops the clock from running and the workbook from reopening.
I don't know what caused it to reopen under the previous code, but at least now it's fine.
By using the below code RefreshData I run mg macro every 10 secs.
I'm unable to stop stoprefresh which is assigned to a square shape.
Sub RefreshData()
Application.OnTime Now + TimeValue("00:00:10"), "mg", , True
End Sub
Sub stoprefresh()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:10"), "mg", , False
End Sub
Sub mg()
ActiveSheet.Cells(ActiveSheet.Cells.Rows.Count, 1).End(xlUp).Offset(1) = "Running"
Call RefreshData
End Sub
Try this code
Option Explicit
Dim iTimerSet As Double
Sub RefreshData()
iTimerSet = Now + TimeValue("00:00:10")
Application.OnTime iTimerSet, "mg", , True
End Sub
Sub stoprefresh()
'On Error Resume Next
Application.OnTime iTimerSet, "mg", , False
End Sub
Sub mg()
ActiveSheet.Cells(ActiveSheet.Cells.Rows.Count, 1).End(xlUp).Offset(1) = "Running"
Call RefreshData
End Sub
Cancelling a scheduled Procedure
It is possible to cancel a procedure that has been scheduled to run but you need to know the
exact date and time it was scheduled for. To cancel a scheduled
procedure you must know the "EarliestTime" it was scheduled for.
Exactly the same syntax except you set the schedule paramater to
False. This tells the application to cancel the schedule.
I have built a small 5 minute Countdown in a UserForm.
The countdown should count down. But if the UserForm is closed, the macro should stop and the timer should be reset.
In the UserForm's Terminateevent I have stored the call of my own abort function. This terminates the UserForm, but the timer continues to run in the background and the corresponding macro is always brought to the foreground.
How can the code be modified to stop the timer when the UserForm is closed?
Module 1
Dim Count As Date
Sub callBreak()
Break.Show
End Sub
Sub Time()
Count = Now + TimeValue("00:00:01")
Application.OnTime Count, "minus"
End Sub
Sub minus()
Dim y As Date
y = Break.Label1.Caption
y = y - TimeSerial(0, 0, 1)
Break.Label1.Caption = y
If y <= 0 Then
Break.Label1.Caption = "Arbeit, Arbeit!"
Exit Sub
End If
Call Time
End Sub
Sub abord()
End
End Sub
Userform:
Sub UserForm_Initialize()
Call Coffeebreak.Time
End Sub
Sub UserForm_Terminate()
Call Coffeebreak.abord
End Sub
You can cancel a previously scheduled procedure by setting the optional Schedule argument of Application.OnTime to False. Try this as your Abord() function:
Sub Abord()
Application.OnTime EarliestTime:=Count, Procedure:="minus", Schedule:=False
End Sub
One solution:
in your module, define a global boolean variable, eg isCancelled. Set this variable to true in abort and check it in minus to prevent that the timer is called again.
Dim Count As Date
Dim isCancelled as Boolean
Sub Time()
isCancelled = False
Count = Now + TimeValue("00:00:01")
Application.OnTime Count, "minus"
End Sub
Sub minus()
if isCancelled Then Exit Sub
(...)
End Sub
Sub abort()
isCancelled = True
End Sub
I am coding a Stopwatch Timer in Excel, and I am trying to add a pause button that will stop the timer, also resume when clicked the 2nd time. I have it almost working, but when it resumes it does not continue the stopwatch at the same time, but rather includes all of the elapsed time. The way I have it working is that when you click the pause button it adds the value of "Paused" to a cell and sets the application to "False". If the button is clicked and the cell already says "Paused" it will empty the cell value and call the StartTimer sub and start the timer again.
Example of problem: If I press the button at 1min and 3secs, wait 3mins and resume the timer, it starts counting again at 4min and 3secs.
Example of goal: If I press the button at 1min and 3secs, wait 3mins and resume the timer, it should start counting again at 1min and 4secs.
Here is my current code that i've been working on:
Dim NextTick As Date, t As Date
Sub StartStopWatch()
t = Time
Call StartTimer
End Sub
Sub StartTimer()
NextTick = Time + TimeValue("00:00:01")
Range("M1").Value = Format(NextTick - t - TimeValue("00:00:01"), "hh:mm:ss")
Application.OnTime NextTick, "StartTimer"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False
End Sub
Sub ResetTimer()
Range("M1").ClearContents
Range("N1").ClearContents
Range("L2").ClearContents
End Sub
Sub PauseButton()
If Range("L2").Value = "" Then
Range("L2").Value = "Paused"
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False
Else
Range("L2").ClearContents
Call StartTimer
End If
End Sub
Your code does not reset the start time when paused. But resetting the start time would lose previous elapsed periods. One approach to this problem is to record the number of elapsed seconds each time the clock stops. Subsequence start/stops are added to the running elapsed counter. There is a reset method so you can begin again from zero.
Private StartTime As Date ' Stores timer start time.
Private StopTime As Date ' Stores timer end time.
Private ElapsedTime As Integer ' Store number of seconds between start and end time.
Private TimerRunning As Boolean ' True when the timer is running.
' Resets ElapsedTime and running status.
Public Sub ResetTimer()
ElapsedTime = 0
If TimerRunning Then TimerRunning = False
End Sub
' Starts the timer.
Public Sub StartTimer()
' Record start time.
StartTime = Time
TimerRunning = True
End Sub
' Stops the timer.
' Displays elapsed seconds.
Public Sub StopTimer()
' Record end time.
StopTime = Time
TimerRunning = False
' Calculate numebr of seconds clock was running for.
' Add total to any previous runs.
ElapsedTime = ElapsedTime + DateDiff("S", StartTime, StopTime)
MsgBox "Clock ran for " & ElapsedTime & " seconds", vbInformation, "Clock Stopped"
End Sub
' Pause the timer.
Public Sub PauseTimer()
' Check current status.
If TimerRunning Then
' Stop the clock, capture the end time
' but do not reset the timer.
StopTimer
Else
' Restart the timer.
StartTimer
End If
End Sub
Users only really need access to the pause and reset functions. You could make the start and stop functions internal private methods.
I've stored the elapsed time in an integer. Date and time variables should be used to record when an event occurred, rather than the duration. Why? Because a time variable supports values from 00:00:00 -> 23:59:59 (times of the day). This leaves no room to record events that lasted longer than a day. You can always format the int when displaying.
I havn't understood how exactly your code works and I tried a couple of things but its not working. Basically what I was trying to to was to take the time from the cell M1 itself the next time it starts and then continue from there itself. Look at this code, maybe it will help.
Dim NextTick As Date, t As Date, continue_time As Date
Sub StartStopWatch()
If Range("L2").Value = "" Then
t = Time
Range("L2").ClearContents
Else
t = TimeValue(Range("M1").Text) - Time
End If
't = Time
Call StartTimer
End Sub
Sub StartTimer()
'If Range("L2").Value = "" Then
' continue_time = Time
'Else
' continue_time = TimeValue(Range("M1").Text)
'End If
NextTick = Time + TimeValue("00:00:01")
Range("M1").Value = Format(NextTick - t - TimeValue("00:00:01"), "hh:mm:ss")
Application.OnTime NextTick, "StartTimer"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False
End Sub
Sub ResetTimer()
Range("M1").ClearContents
Range("N1").ClearContents
Range("L2").ClearContents
End Sub
Sub PauseButton()
If Range("L2").Value = "" Then
Range("L2").Value = "Paused"
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False
Else
Call StartStopWatch
End If
End Sub
I actually just figured it out using a code that counts integers and then changed the formatting to mm:ss.
Solution: http://www.ozgrid.com/forum/showthread.php?t=153966
I'm using Excel 2010, and want to create a countdown timer in excel. The code will be started and stopped by using buttons with macros attached to them. The problem occurs when the "start" button is pushed. The code above is utilizing Cell "B1" as the input spot, because I was just trying to get it to work, but every time I tried, it would always say:
"Cannot run the macro . The macro may not be available in this workbook or all macros may be disabled".
Yes I enabled all macros before putting this here. I want to be able to take user input, and to make that the time that the timer starts at instead of just using cell "B1".
'Macro for Starting the timer (attached to the start button)
Sub startTimer()
Application.OnTime Now + TimeValue("00:00:01"), "nextTick"
End Sub
'Macro for next second
Sub nextTick()
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
startTimer
End Sub
'Macro for stopping the timer (attached to the end button)
Sub stopTimer()
Application.OnTime Now - TimeValue("00:00:01"), "nextTick", , False
End Sub
I modified your code very slightly and put it in a standard module:
Public Future As Double
Sub StartTimer()
Future = Now + TimeSerial(0, 0, 1)
Application.OnTime earliestTime:=Future, procedure:="nextTime", _
schedule:=True
End Sub
Sub nextTime()
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
StartTimer
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliestTime:=Future, _
procedure:="nextTime", schedule:=False
End Sub
Both StartTimer() and StopTimer() run just fine.