asked on

Difference in seconds between two times.

Looking for a solution to finding the difference in seconds between two times in 24 hour format. Times are given as hhmmss. Example: Start Time 180000, Stop Time 183000. Time difference is 30 minutes or 1800 seconds. Also have situation for Start Time 235959, Stop time 000010 which should be 11 seconds. Times are never more than 24 hours apart. I have a temporary solution, but it doesn't seem very elegant. Any suggestions to make this better and faster. Occasionally I have 60,000 or 80,000 of these to loop through and calculate. I made a form with 3 text boxes and a command button to test the code. txtStart and txtStop input the respective times and txtDifference shows result in seconds. Current code follows:

Private Sub cmdCalculate_Click()

'~~~ Calculate difference between two times
'~~~ in seconds. The two times are always presented
'~~~ as hhmmss, and are NEVER more than 18 hours
'~~~ apart. Start time can be any time in 24
'~~~ hour format between 000000 and 235959. Stop
'~~~ time can be from one second after the Start
'~~~ time to 18 hours after the Start Time.
'~~~ Calculate the time difference in seconds.

Dim StartTime As Date
Dim StopTime As Date
Dim Difference As String
Dim Seconds As Long

'~~~ Convert the hhmmss input into hh:mm:ss format

StartTime = CDate(Mid(txtStart.Text, 1, 2) & ":" & Mid(txtStart.Text, 3, 2) & ":" _
& Mid(txtStart.Text, 5, 2))

'~~~ Convert the hhmmss input into hh:mm:ss format

StopTime = CDate(Mid(txtStop.Text, 1, 2) & ":" & Mid(txtStop.Text, 3, 2) & ":" _
& Mid(txtStop.Text, 5, 2))

'~~~ Find difference between StartTime and StopTime

Difference = Format(CDbl(StopTime) - CDbl (StoptTime), "HhNnSs")

'~~~ Calculate Seconds from HHMMSS string.

Seconds = (Mid(Difference, 1, 2) * 3600) + (Mid(Difference, 3, 2) * 60) _
+ (Mid(Difference, 5, 2))

'~~~ Determine if StopTime was over a midnight.

If CDate(StartTime) < CDate(StopTime) Then
txtDifference.Text = Seconds
Else
txtDifference.Text = (Seconds - 86400) * -1
End If

End Sub

Ark

Private Sub Command1_Click()
Text1 = SecDiff("10/10/01 23:59:30", "11/10/01 00:00:10")
End Sub

Private Function SecDiff(dt1 As Date, dt2 As Date) As Long
SecDiff = DateDiff("s", dt1, dt2)
End Function

Cheers

Ark

PS.
My locale Date format is dd/mm/yy
If you're using US format (mm/dd/yy), just change:

Text1 = SecDiff("10/10/01 23:59:30", "10/11/01 00:00:10")

and you'll receive same result - 40 sec

Cheers

Ark

Or, if you don't want use date:

Private Sub Command1_Click()
Text1 = SecDiff("23:59:30", "00:00:10")
End Sub

Private Function SecDiff(dt1 As Date, dt2 As Date) As Long
SecDiff = DateDiff("s", dt1, dt2)
If SecDiff < 0 Then SecDiff = SecDiff + 86400
End Function

Cheers

ASKER CERTIFIED SOLUTION

ameba

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Nosterdamus

Hi Mitch,

The following code includes 2 functions:
1. Function GetSecondsDiff
2. Function StrToSeconds
and a Test() sub to test the functions mentioned.

The functions are self exlainatory with comments all over, so it whould be easy to understand. Yet, if some more info is needed, then drop a line.

In the Test() Sub, pls feel free to play with the strStartTime and strEndTime constants to check for a different time diff calculations. In addition, Test() gives you an example of how to use the variouse Err_Codes that GetSecondsDiff can return.

To apply the code in your app, all you need to do is:
call GetSecondsDiff (StartTime, EndTime)
where StartTime and EndTime are variables of type String in "hhmmss" format.

--------- Start Code -------------

Option Explicit

Const SECS_IN_HOUR = 3600
Const SECS_IN_MINUTE = 60
Const DISTINCT_START_END_TIMES = 100

Const Err_WRONG_TIME_FORMAT = -10
Const Err_WRONG_HOUR = -20
Const Err_WRONG_MINUTE = -30
Const Err_WRONG_SECOND = -40

Public Function GetSecondsDiff(StartTime As String, EndTime As String) As Long

Const ADD_24_HOURS = 86400 'Seconds per day

Dim numStartTime As Long
Dim numEndTime As Long

If Len(StartTime) <> 6 Or Len(EndTime) <> 6 Then
'Wrong time format
GetSecondsDiff = IIf(Len(StartTime) <> 6, _
Err_WRONG_TIME_FORMAT, _
Err_WRONG_TIME_FORMAT * DISTINCT_START_END_TIMES)
'The * DISTINCT_START_END_TIMES operation is to
'distinct Err_WRONG_TIME_FORMAT between StartTime & EndTime
Else
'Calculate Time Diff
numStartTime = StrToSeconds(StartTime)
numEndTime = StrToSeconds(EndTime)
If numStartTime < 0 Or numEndTime < 0 Then
'Error in numStartTime return valuse possible:
' Err_WRONG_HOUR
' Err_WRONG_MINUTE
' Err_WRONG_SECOND
'Error in numEndTime return valuse possible:
' Err_WRONG_HOUR * DISTINCT_START_END_TIMES
' Err_WRONG_MINUTE * DISTINCT_START_END_TIMES
' Err_WRONG_SECOND * DISTINCT_START_END_TIMES
' The * 10 operation is to distinct Errors between StartTime & EndTime
GetSecondsDiff = IIf(numStartTime < 0, _
numStartTime, _
numEndTime * DISTINCT_START_END_TIMES)
Else
If numEndTime < numStartTime Then
'Add 24 Hrs to EndTime
numEndTime = numEndTime + ADD_24_HOURS
End If
GetSecondsDiff = numEndTime - numStartTime
End If
End If
End Function

Function StrToSeconds(strTimeToConvert As String) As Long

Dim h As Long
Dim m As Long
Dim s As Long

h = Val(Left(strTimeToConvert, 2))
m = Val(Mid(strTimeToConvert, 3, 2))
s = Val(Right(strTimeToConvert, 2))

h = IIf(h > 23 Or h < 0, Err_WRONG_HOUR, h * SECS_IN_HOUR)
m = IIf(m > 59 Or m < 0, Err_WRONG_MINUTE, m * SECS_IN_MINUTE)
s = IIf(s > 59 Or s < 0, Err_WRONG_SECOND, s)

If h < 0 Then
StrToSeconds = h
ElseIf m < 0 Then
StrToSeconds = m
ElseIf s < 0 Then
StrToSeconds = s
Else
StrToSeconds = h + m + s
End If

End Function

Sub test()

Const strStartTime = "235959"
Const strEndTime = "000002"

Dim SecondsDiff As Long
Dim MsgBody As String
Dim MsgTitle As String
Dim MsgButton As Integer

SecondsDiff = GetSecondsDiff(strStartTime, strEndTime)

Select Case SecondsDiff
'GOOD Result
Case Is > 0
MsgBody = "Time diff for:" & vbCrLf & vbCrLf & _
"Start = " & vbTab & strStartTime & vbCrLf & _
"End = " & vbTab & strEndTime & vbCrLf & vbCrLf & _
"Is:" & vbCrLf & vbCrLf & _
SecondsDiff & " Seconds"
MsgButton = vbOKOnly
MsgTitle = "Seconds Diff"
Case Is = 0
MsgBody = "StartTime = EndTime!" & vbCrLf & vbCrLf & _
"Start = " & vbTab & strStartTime & vbCrLf & _
"End = " & vbTab & strEndTime & vbCrLf & vbCrLf
MsgButton = vbOKOnly
MsgTitle = "Seconds Diff"

'Error handling

'StartTime Error handling
Case Is = Err_WRONG_TIME_FORMAT
MsgBody = "StartTime format is wrong!" & vbCrLf & vbCrLf & _
"StartTime entered is: " & strStartTime & vbCrLf & _
"Please enter time in ""hhmmss"" (Hours, Minutes, Seconds) format"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
Case Is = Err_WRONG_HOUR
MsgBody = "Hour for StartTime is wrong!" & vbCrLf & vbCrLf & _
"StartTime entered is: " & strStartTime & vbCrLf & _
"Please enter hours for StartTime in the range of 00 - 23"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
Case Is = Err_WRONG_MINUTE
MsgBody = "Minutes for StartTime is wrong!" & vbCrLf & vbCrLf & _
"StartTime entered is: " & strStartTime & vbCrLf & _
"Please enter Minutes for StartTime in the range of 00 - 59"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
Case Is = Err_WRONG_SECOND
MsgBody = "Seconds for StartTime is wrong!" & vbCrLf & vbCrLf & _
"StartTime entered is: " & strStartTime & vbCrLf & _
"Please enter Seconds for StartTime in the range of 00 - 59"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
'Endtime error handling
Case Is = Err_WRONG_TIME_FORMAT * DISTINCT_START_END_TIMES
MsgBody = "EndTime format is wrong!" & vbCrLf & vbCrLf & _
"EndTime entered is: " & strEndTime & vbCrLf & _
"Please enter time in ""hhmmss"" (Hours, Minutes, Seconds) format"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
Case Is = Err_WRONG_HOUR * DISTINCT_START_END_TIMES
MsgBody = "Hour for EndTime is wrong!" & vbCrLf & vbCrLf & _
"EndTime entered is: " & strEndTime & vbCrLf & _
"Please enter hours for EndTime in the range of 00 - 23"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
Case Is = Err_WRONG_MINUTE * DISTINCT_START_END_TIMES
MsgBody = "Minutes for EndTime is wrong!" & vbCrLf & vbCrLf & _
"EndTime entered is: " & strEndTime & vbCrLf & _
"Please enter Minutes for EndTime in the range of 00 - 59"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
Case Is = Err_WRONG_SECOND * DISTINCT_START_END_TIMES
MsgBody = "Seconds for EndTime is wrong!" & vbCrLf & vbCrLf & _
"EndTime entered is: " & strEndTime & vbCrLf & _
"Please enter Seconds for EndTime in the range of 00 - 59"
MsgButton = vbCritical
MsgTitle = "Seconds Diff - Error"
End Select
MsgBox MsgBody, MsgButton, MsgTitle
End Sub

--------- End Code -------------

Hope this helps,

Nosterdamus

MitchSavage

ASKER

ameba,
The diff3 function is exactly what I was looking for. It returns the right answers from my input data, is probably as fast as possible, and is in fact much more elegant than the way I was doing it. Thanks alot.
Best Regards
Mitch.....

ameba

Thank you!

Small tip:
"Don't use = operator on Date values" http://www.vb2themax.com/Item.asp?PageID=TipBank&ID=296