countdown timer that continues counting past zero

Vtookup

Board Regular
Joined
May 30, 2017
Messages
98
Hi all.
looking for help with countdown timer codes that continue counting pass zero.
found these codes
Code:
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,000
This is because you never stop the timer. Your test:
Code:
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

Board Regular
Joined
May 30, 2017
Messages
98
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.
 
Last edited:

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,000
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

Board Regular
Joined
May 30, 2017
Messages
98
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,000
Your requirements are still bit vague, but this will do something like a trafffic light:
Code:
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

Board Regular
Joined
May 30, 2017
Messages
98
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,000
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.
Code:
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

Board Regular
Joined
May 30, 2017
Messages
98
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!
 

Forum statistics

Threads
1,081,423
Messages
5,358,595
Members
400,505
Latest member
JacquiT

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top