Counting time over midnight fails
Counting time over midnight fails
I have made a code with two counters - one (CountUPS) that counts seconds from 0 every time I start the program (A1) and one(CountUP) that counts seconds from a preset time (A2).
It works fine while it counts within the same day, but it gets a bug every time it shall count over midnight. It stops when A2 reach 23:37:53 in time.
Is something wrong in my definition of values?
Sub RunMe()
Dim StartS As Single
Dim CellS As Range
Dim Cellt As Range
Dim CountUPS As Date
Dim CountUp As Date
'Timer is the number of seconds since midnight.
'Store timer at this point in a variable
StartS = Timer
'Store A1 in a variable to make it easier to refer
'to it later. Also, if the cell changes, you only
'have to change it in one place
Set CellS = Sheet1.Range("A1")
'This is the starting value.
CountUPS = TimeSerial(0, 0, 0)
'Set our cell to the starting value
CellS.Value = CountUPS
Set Cellt = Sheet1.Range("A2")
CountUp = Sheet1.Range("A2")
b_pause = True
Do While CellS.Value >= 0
CellS.Value = CountUPS + TimeSerial(0, 0, Timer - StartS + (StartS > Timer))
Cellt.Value = CountUp + TimeSerial(0, 0, Timer - StartS + (StartS > Timer))
DoEvents
Loop
End Sub
The error messages clear up a lot of issues.
- The
overflow error, as has been pointed out, is because of the integer constraints on the TimeSerial function arguments.
- The
1004 error, occurring at midnight, is because, when Timer reverts to 0 at midnight, your expression for seconds is a negative number. Unless you are using the 1904 date system, you cannot express negative times in Excel.
- In trying to adjust for "passing midnight" you are conflating seconds and days, and Excel and VBA. You are, in your macro, trying to add one second, whereas you probably really want to add one day. Also, since
True in VBA equates to -1, you are actually subtracting instead of adding anyway!
I think the following modifications may work, but have not tested them extensively. 86400 is the number of seconds in a day.
Option Explicit
Sub RunMe()
Dim StartS As Single
Dim CellS As Range
Dim Cellt As Range
Dim CountUPS As Date
Dim CountUp As Date
'Timer is the number of seconds since midnight.
'Store timer at this point in a variable
StartS = TIMER
'Store A1 in a variable to make it easier to refer
'to it later. Also, if the cell changes, you only
'have to change it in one place
Set CellS = Sheet1.Range("A1")
'This is the starting value.
CountUPS = TimeSerial(0, 0, 0)
'Set our cell to the starting value
CellS.Value = CountUPS
Set Cellt = Sheet1.Range("A2")
CountUp = Sheet1.Range("A2")
'b_pause = True
Do While CellS.Value >= 0
CellS.Value = CountUPS + (TIMER - StartS - 86400 * (StartS > TIMER)) / 86400
Cellt.Value = CountUp + (TIMER - StartS - 86400 * (StartS > TIMER)) / 86400
DoEvents
Loop
End Sub
