countdown timer that continues counting past zero

[Vtookup]

Hi all.
looking for help with countdown timer codes that continue counting pass zero.
found these codes

Sub starttimer()Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End Sub
Sub nexttick()
If Sheet1.Range("B1") = 0 Then Exit Sub
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
If Sheet1.Range("B1").Value <= TimeValue("00:00:10") Then
    Sheet1.Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Sheet1.Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 255, 0)
End If
starttimer
End Sub
Sub stoptimer()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "nexttick", , False
End Sub
Sub ResetTimer()
Sheet1.Range("B1") = TimeValue("00:02:00") ' make this the time you want to reset it to
starttimer
End Sub

like to go further by continue counting after zero. start counting from 10 minutes to 30 minutes after zero
instead of color background, i like the font to change color. turn red after exceed zero.
hope this is not too much to ask.
any help is much appreciated.
Thanks

 

[offthelip]

This is because you never stop the timer. Your test:

If Sheet1.Range("B1") = 0 Then Exit Sub

is very unlikely to ever be called because you keeep subtracting a time value which is a floating point number the chances of this ending being equal to zero is practicaly zero!!
Once past that test you never set B1 to zero which would cause the above test to work, and you never call the sub stoptimer.
So you need to get your logic sorted.

 

[Vtookup]

Hi offthelip.
i know how the code work (I'm using it). sorry i wasn't clear enough that i want this code tweaked to get what i want to achieved.
maybe change the code completely. again my apology.

 

[offthelip]

I was unable to "tweak" your code because your requirements are unclear, I suggest you write out your requirements fully and in a logical time sequenced order , once you have done that actually converting the requirements to code is trivial.

 

[Vtookup]

Hello.
First of all, this is not my code, found it online and and found it useful to my need. thanks to the author.
what i need is a similar timer to be able to time and proceed after zero. (mm:ss)
and just like traffic light, YELLOW if counting near zero, one or two mins warning, and finally RED if exceeded zero. could be nicer if it blinks. (Sorry if i'm asking too much, just excited. Turning Red will do)
i have three buttons, to start, stop and reset.
input count sequence in cell B2.
Thanks offthelip.

 

[offthelip]

Your requirements are still bit vague, but this will do something like a trafffic light:

Dim Currentcolour As String

Dim stopflag As Boolean








Sub starttimer()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
Sheet1.Range("B1").Value = TimeValue("00:00:10") ' adjust as necessary
Currentcolour = "Green"
stopflag = False


End Sub
Sub nexttick()


Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
If Sheet1.Range("B1").Value <= TimeValue("00:00:00") Then
  If Currentcolour = "Yellow" Then
   Currentcolour = "Red"
   Sheet1.Range("B1").Value = TimeValue("00:00:00")
  Else
    If Currentcolour = "Green" Then
     Currentcolour = "Yellow"
     Sheet1.Range("B1").Value = TimeValue("00:00:15") ' adjust as necessary
    End If
  End If
End If
' Set colours
If Currentcolour = "Green" Then
         ActiveSheet.TextBox1.BackColor = vbGreen
End If
If Currentcolour = "Yellow" Then
         ActiveSheet.TextBox1.BackColor = vbYellow
End If
If Currentcolour = "Red" Then
         ActiveSheet.TextBox1.BackColor = vbRed
End If
If Not (stopflag) Then
  Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End If
End Sub
Sub stoptimer()
stopflag = True


End Sub

 

[Vtookup]

Thanks again offthelip for the codes.
tried the code, the font color didn't change. and the time loop back to original time after zero.
sorry for being vague, what i meant was
after the countdown reaches zero, i want it to count up again, starting from seconds to minutes.
count up time will turn the font into red color.
while in counting down, i want the font to turn yellow when it is < 2 minutes.
thanks again

 

[offthelip]

Some time ago when I was getting paid to develop software my boss said to me “Always give the customer what they asked for NOT what they want, this means that when we deliver the software they have to pay us to modify it to what they want”
Your vague requirements would leave you wide open to this:
I believe that this software will do what you asked. I will be surprised if it is what you want!! With my last iteration I was guessing a bit as to what you want. Now you say you want the font to change colour but haven’t told me where the text is , So I can make that decision myself, and I have decided to change the colour of the text in the timer since that is the only place I know there is some text. If that is wrong you can modify it yourself very easily because I have used good software method of low coupling by isolating the timer code from the formatting code.
So just change the 3 lines of code with VBred, Vbyellow and VbRed, to whatever you need to change the format of.

Dim Currentcolour As String


Dim stopflag As Boolean




Sub starttimer()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
Sheet1.Range("B1").Value = TimeValue("00:00:10") ' adjust as necessary
Currentcolour = "Green"
stopflag = False




End Sub
Sub nexttick()


If Currentcolour = "Red" Then
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value + TimeValue("00:00:01")
Else
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
End If
If Sheet1.Range("B1").Value <= TimeValue("00:00:00") Then
  If Currentcolour = "Yellow" Then
   Currentcolour = "Red"
 '  Sheet1.Range("B1").Value = TimeValue("00:00:00")
  Else
    If Currentcolour = "Green" Then
     Currentcolour = "Yellow"
     Sheet1.Range("B1").Value = TimeValue("00:00:15") ' adjust as necessary
    End If
  End If
End If
' Set colours
If Currentcolour = "Green" Then
         Range(Cells(1, 2), Cells(1, 2)).Font.Color = vbGreen
End If
If Currentcolour = "Yellow" Then
         Range(Cells(1, 2), Cells(1, 2)).Font.Color = vbYellow
End If
If Currentcolour = "Red" Then
         Range(Cells(1, 2), Cells(1, 2)).Font.Color = vbRed
End If
If Not (stopflag) Then
  Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End If
End Sub
Sub stoptimer()
stopflag = True




End Sub

 

[Vtookup]

Hello again offthelip.
Pardon my ignorance, I am not a programmer or anywhere near it. if i annoy you by being vague it's because i'm really clueless. sorry.
anyway your code keep the clock running. the way i want it.
as for the colors and the cell location, spot-on.
Thank you for your patience and help.
i'm proud i got help from a software developer.
More power to you!