View Single Post
  #14   Report Post  
Posted to microsoft.public.excel.programming
dgold82 dgold82 is offline
external usenet poster
 
Posts: 99
Default Help with code - countdown timer


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" wrote:

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



"dgold82" wrote in message
...
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" wrote:

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

then B5 to D4 later in the code

"dgold82" wrote in message
...
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" wrote:

well done

best regards
Patrick

"dgold82" wrote in message
...
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" wrote:

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

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

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" wrote in message
...
I found great VBA code online for a countdown timer that fits my
need
perfectly. He
http://www.vbaexpress.com/kb/getarti...b_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