Help with code - countdown timer

[dgold82]

I found great VBA code online for a countdown timer that fits my need
perfectly. Here: http://www.vbaexpress.com/kb/getarticle.php?kb_id=478#instr

I'm a beginner when it comes to writing code and can use some help tweaking
it for my needs. I would like to do 2 things with the code:
1. Keep the whole thing on one sheet (i.e. start and stop button and inputs
on one sheet).
2. Change the countdown format display in mm:ss format.

Here is the code without going to the website:

Sheet1
________
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Status As Boolean

Private Sub cmdStart_Click()
Status = True
Dim WarningTime As Integer
Dim Period As Double
Dim MyTime As Double

With Sheets("Main")
If (.Cells(5, 1) = "") Then
WarningTime = .Cells(5, 4)
Else
WarningTime = .Cells(5, 1)
End If

If (.Cells(8, 1) = "") Then
Period = .Cells(8, 4)
Else
Period = .Cells(8, 1)
End If
End With

If (Period < 0.01) Then Period = 0.01

With Sheets("Counter").Cells(2, 1)
.FormatConditions.Delete
.FormatConditions.Add xlCellValue, xlLessEqual, WarningTime
With .FormatConditions(1).Font
.Bold = True
.ColorIndex = 3
End With
.NumberFormat = Choose(Log(Period) / Log(10) + 3, "0.00", "0.0", "0")

.Value = Sheets("Main").Cells(2, 1).Value + Period
Sheets("Counter").Activate
While (.Value > Period And Status)
.Value = .Value - Period
MyTime = .Value
For i = 1 To 100 * Period
Sleep 10
MyTime = MyTime - 0.01
If (MyTime <= 0) Then Exit For
DoEvents
Next i
Wend
If (.Value <= Period) Then .Value = "Time Up!"
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Row = 2 And Target.Column = 1) Then
Cells(5, 1).Value = Cells(5, 4).Value
End If
End Sub

Sheet 2
_________________

Private Sub cmdStop_Click()
Sheets("Counter").Cells(2, 1).FormatConditions.Delete
Sheets("Main").Status = False
Sheets("Main").Activate
End Sub

 

[dgold82]

Just found a potential fatal flaw. The cell that displays the count down
stops if I input anything else on the sheet. This won't work for me since my
users will be entering data on multiple worksheets while this is supposed to
be counting down. The timer needs to keep going until a user clicks stop or
it just runs down.

Don't know if anyone can help with this problem, but it kills my goal with
this. Any other solution would be helpful.

 

[dgold82]

Any takers on this one. I have been experimenting a bit and discovered that
the problem below won't really affect me since my user input is based
entirely on radio buttons. My 2 issues still remain.

 

[Patrick Molloy]

something simple ...

two buttons, one to start, one to stop
this will run for 10 seconds unless you click the stop
modifying this simple code should be , er, simple
cells B4 and B5 for code output



Option Explicit
Private bStopTimer As Boolean
Sub StartTimer()
Dim tmr As Long
bStopTimer = False
tmr = Timer
Range("B4:B5") = ""
Do
Range("B4").Value = Int(Timer - tmr)
DoEvents
If bStopTimer Then Exit Do
Loop Until Timer > tmr + 10

If bStopTimer Then
Range("B5") = "User cancelled"
Else
Range("B5") = "Timer finished"
End If
End Sub
Sub quitTimer()
bStopTimer = True
End Sub

 

[dgold82]

Thanks Patrick!! Much simpler!
Quick things
1. Need it to countdown is h:mm:ss format instead of up. Users are taking a
timed test and countdown timer is better for our purposes. For example, if it
is a 40 min test then I would like the cell to disaply "0hrs, 40min, 00sec
remaining" and then the users clicks start and it goes down from there.
Alternatively, 0:40:00 would work too.

Thanks!

 

[dgold82]

So I thought this through a little more this evening and came up with a
rather simple solution...don't laugh.

All I did was pick another cell and typed in "=(2700-B4)/86400"-->changed
the the format to h:mm:ss-->DONE! This was for a 45min countdown so 2700
seconds. The cell now counts down.

Thank you for the simple code!!!

 

[Patrick Molloy]

well done

best regards
Patrick

So I thought this through a little more this evening and came up with a
rather simple solution...don't laugh.

All I did was pick another cell and typed in "=(2700-B4)/86400"-->changed
the the format to h:mm:ss-->DONE! This was for a 45min countdown so 2700
seconds. The cell now counts down.

Thank you for the simple code!!!

 

[dgold82]

Thanks again. Once quick follow-up question:
How do I change the range, say instead of B4:B5--I would like B4 and D4. B4
would display the timer and D4 would display the text?

 

[Patrick Molloy]

change this
Range("B4:B5") = ""
to
Range("B4,D4") = ""

then B5 to D4 later in the code

 

[dgold82]

Thanks!

change this
Range("B4:B5") = ""
to
Range("B4,D4") = ""

then B5 to D4 later in the code

 

[dgold82]

Hi Patrck--

Have another question (user request actually). Is there a way to add a pause
function to your original code? Right now we have a start and stop button.

Thanks, David.

 

[Patrick Molloy]

A1 is empty. enter something to cause a pause. clear it to continue

Option Explicit

Private bStopTimer As Boolean
Sub StartTimer()
Dim tmr As Long
bStopTimer = False
tmr = Timer
Range("B4:B5") = ""
Do
Range("B4").Value = Int(Timer - tmr)
DoEvents
If bStopTimer Then Exit Do
If Range("A1").Value <> "" Then
Do
DoEvents
Loop Until Range("A1").Value = ""
End If

Loop Until Timer > tmr + 100

If bStopTimer Then
Range("B5") = "User cancelled"
Else
Range("B5") = "Timer finished"
End If
End Sub
Sub quitTimer()
bStopTimer = True
End Sub

Hi Patrck--

Have another question (user request actually). Is there a way to add a
pause
function to your original code? Right now we have a start and stop button.

Thanks, David.

if range("A1")<>"" then do
doevents
loop until range("A1" = ""
end if

 

[dgold82]

Thanks Patrick. Putting something in A1 after the timer starts actually gave
me an error. Tried to get around it by making a checkbox insert something in
A1. The error went away and the timer actually paused BUT when A1 was cleared
the timer time reflected the time that had passed as opposed to a true pause.
So if I inputted something in A1 at 10 seconds and then cleared A1 5 seconds
later, the timer resumed at 15 sec as opposed to 10 seconds.

 

[Patrick Molloy]

yes, because the tmr variable is set with the start record when the code
first runs
you need to add the paused interval to the delay if you want to continue

I'd suggest that you add a PAUSE button, similar to the way that you did a
STOP button and save the timer value. when resuming take the saved timer
value from the pause away from the current timer value, and this difference
needs to be added to the original tmr value, so that the gap is covered so
to speak.

 

[dgold82]

Hi again Patrick (don't know if you are notified of replies). So I am finally
getting around to the second version of my application and have resurrected
this pause feature. I tried and tried to figure out your instructions below
but I just don't know the code.

Adding the pause button like you suggest would be ideal, I just can't figure
it out.