PDA

View Full Version : Timer counter



PHCEO
06-18-2013, 07:21 AM
Hey all... intermittent VBA dabbler here. I'm creating a module in an Excel spreadsheet. The end result will be that clicking a button will do two things:

1. Start 30 minute countdown timer in one cell
2. Display the time 30 minutes from the button click. So if you click the button at 11:45 it will say "12:15" in the other cell.

Every time you click the button, I want it to reset the timer back to 30 minutes and update the other cell from the current time. Simple. The code works fine. I've just run into one problem. Every time you click the button, it re-executes the code without shutting down the active processes. So if you click the button four times in succession, the timer starts counting down really fast and all hell starts to break lose from multiple open macros. I have Googled, I have read, I am giving up and asking for help. What commands can I use in the first sub Reset to check to see if the other processes are running, and if they are, kill them before proceeding? I'm sure its something very simple and I will feel very dumb when you tell me. Here is the code.


Sub Reset()
Dim Timer As Range
Dim Timex As Range
Set Timer = [D2]
Set Timex = [E2]
Timer.Value = TimeValue("00:30:00")
Timex.Value = 0
Application.Run "InsertTimey"
End Sub

Sub InsertTimey()
Dim RTFN As Range
Set RTFN = [E2]
RTFN.Value = Now + TimeValue("00:30:00")
Application.Run "Countup"
End Sub

Sub Countup()
Dim CountDown As Date
CountDown = Now + TimeValue("00:00:01")
Application.OnTime CountDown, "Realcount"
End Sub

Sub Realcount()
Dim Count As Range
Set Count = [D2]
Count.Value = Count.Value - TimeSerial(0, 0, 1)
If Count <= 0 Then
MsgBox "All Clear"
Exit Sub
End If
Call Countup
End Sub

Thanks for any help you can give!

Jan Karel Pieterse
06-18-2013, 08:33 AM
You have to keep score of when the next Ontime is Scheduled by storing it's time in a module variable and then when the button is clicked you need to unschedule the previously set ontime event, some code:

Option Explicit
Dim mdNextTime As Double
Sub ScheduleNext()
'make sure any pending event is cancelled first
If mdNextTime <> 0 Then Unschedule
mdNextTime = Now + TimeValue("00:10:00")
Application.OnTime mdNextTime, "UpdateRoutine"
End Sub
Sub Unschedule()
'Prevent error in case nothing was scheduled
On Error Resume Next
'Unschedule pending ontime proc
Application.OnTime mdNextTime, "UpdateRoutine", , False
End Sub
Sub UpdateRoutine()
'Update routine goes here
mdNextTime = Now + TimeValue("00:10:00")
Application.OnTime mdNextTime, "UpdateRoutine"
End Sub