Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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

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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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

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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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.

"dgold82" wrote:

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

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

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,049
Default Help with code - countdown timer

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




  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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!


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


  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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
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


  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,049
Default Help with code - countdown timer

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
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


  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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
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


  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,049
Default Help with code - countdown timer

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
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




  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

Thanks!

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


  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer


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
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


  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,049
Default Help with code - countdown timer


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


  #14   Report Post  
Posted to microsoft.public.excel.programming
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


  #15   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,049
Default Help with code - countdown timer


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




  #16   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 99
Default Help with code - countdown timer

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.

"Patrick Molloy" wrote:

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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to set up countdown timer to countdown days to a specific day Jenny Excel Worksheet Functions 3 May 8th 23 07:43 PM
Countdown Timer Robert_NSBG Excel Discussion (Misc queries) 1 December 11th 08 08:54 PM
Countdown Timer Mike B.[_2_] Excel Programming 6 June 24th 08 03:01 PM
Countdown timer Jock Excel Programming 15 May 21st 07 02:16 PM
HELP for COUNTDOWN TIMER CC Excel Discussion (Misc queries) 3 May 8th 06 12:44 PM


All times are GMT +1. The time now is 03:06 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"