Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to set up countdown timer to countdown days to a specific day | Excel Worksheet Functions | |||
Countdown Timer | Excel Discussion (Misc queries) | |||
Countdown Timer | Excel Programming | |||
Countdown timer | Excel Programming | |||
HELP for COUNTDOWN TIMER | Excel Discussion (Misc queries) |