Visible countdown timer

[SJW_OST]

Hello,
I am using the following timer code to perform a macro in 15 minute
increments. I have included the start and stop timer codes just to be
thorough.

Public RunWhen As Double
Public Const cRunIntervalSeconds = 900 ' 15 minutes
Public Const cRunWhat = "MACRO1" ' the name of the procedure to run

Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True
End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False
End Sub

What I am looking for is a visible timer that will run off of this timer
with-in a cell of my choosing that will count down from what ever the "Public
Const cRunIntervalSeconds = ###" number is set to down to zero then restart
back at that number when the timer is started again.
Can someone help me with this? Your help is GREATLY appreciated.

 

[Chip Pearson]

That code looks familiar. You can use the code like the following. Change
the reference in the With statement to the appropriate sheet and cell. If
the cell is blank, it is initialized to some time value specified in the
code. If the value is > 0, it is reduced by 15 minutes. If the value is <=
0, the countdown is terminated. Change the lines marked with <<< CHANGE to
suit your needs.


Sub TheMacro()
With ThisWorkbook.Worksheets("Sheet1").Range("A1") '<<< CHANGE
If Len(.Text) = 0 Then
' first time though -- set initial value
.Value = TimeSerial(1, 0, 0) 'or some valid time <<< CHANGE
.NumberFormat = "hh:mm:ss"
Else
If .Value <= 0 Then
' end of countdown
StopTimer
Else
' reduce value by 15 minutes
.Value = Application.Max(.Value - Time(0, 15, 0), 0) '<<< CHANGE
End If
End If
End With
End Sub


--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Chip Pearson]

.Value = Application.Max(.Value - Time(0, 15, 0), 0) '<<< CHANGE
should be
.Value = Application.Max(.Value - TimeSerial(0, 15, 0), 0) '<<<
CHANGE


--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[SJW_OST]

Ok, I've done that but I can not get it to tick down the time. This is what
I've done and I know it's not right I just don't know how to tell it to "tick
down" as the seconds pass.

Sub TheMacro()
Run "StartTimer"
1:
With ThisWorkbook.Worksheets("Sheet1").Range("A1")
If Len(.Text) = 0 Then
' first time though -- set initial value
.Value = TimeSerial(1, 0, 0) 'or some valid time <<< CHANGE
.NumberFormat = "hh:mm:ss"
Else
If .Value <= 0 Then
' end of countdown
StopTimer
GoTo 2
Else
' reduce value by 15 minutes
.Value = Application.Max(.Value - TimeSerial(0, 0, 1), 0)
'<<<Change
End If
End If
End With
GoTo 1
2:
ThisWorkbook.Worksheets("Sheet1").Range("A1").Clear
End Sub

Thank you for your help.

 

[Chip Pearson]

You can only "tick down" the value in the cell at the interval specified by
the cRunIntervalSeconds value. There is no way to have a "countdown" cell
whose value decreases every second unless you make a call from OnTime every
second.


--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[SJW_OST]

Ok, how would I accomplish making a call from "OnTime" every second? Can or
would I tie the OnTime call to cRunIntervalSeconds? I guess that would be
prefered in this instance. How to do this? Help?

By the by, you have been a tremendous help as I am a novice at this but I am
putting 2 & 2 together slowly. Thank you.