Type TimeType
Hours As Integer
Minutes As Integer
Seconds As Integer
Milliseconds As Integer
End Type
Sub CalcTimeDifference()
Dim sTime1 As String
Dim sTime2 As String
Dim aDT As Variant
Dim udtTime1 As TimeType
Dim udtTime2 As TimeType
Dim TimeInterval As Double
Dim sUnits As String
Dim FormatString As String
sTime1 = ActiveSheet.Cells(1, 2).Value 'Get time 1 from worksheet
sTime2 = ActiveSheet.Cells(2, 2).Value 'Get time 2 from worksheet
aDT = Split(sTime1, " ") 'Separate date / time substrings
udtTime1 = TimeTypeFromString(aDT(UBound(aDT))) 'Get time components from time portion of aDT
aDT = Split(sTime2, " ")
udtTime2 = TimeTypeFromString(aDT(UBound(aDT)))
TimeInterval = TimeDifference(udtTime2, udtTime1) 'Compute difference in seconds
If TimeInterval < 1 Then
TimeInterval = TimeInterval * 1000
sUnits = "milliseconds"
FormatString = "####"
Else
sUnits = "seconds"
FormatString = "##.####"
End If
MsgBox "Time Interval (" & sUnits & ") = " & Format(TimeInterval, FormatString)
End Sub
Function TimeTypeFromString(ByVal T As String) As TimeType
' Parses a time string with format HH:MM:SS.nnn
' Returns time components as the user-defined type TimeType (Hours/Minutes/Seconds/Milliseconds)
Dim Pos As Integer
Dim udtTemp As TimeType
Dim Intervals As Variant
Dim NumOfIntervals As Integer
With udtTemp
Pos = InStr(1, T, ".", vbBinaryCompare)
If Pos > 0 Then
.Milliseconds = CInt(Mid$(T, Pos + 1))
T = Left$(T, Pos - 1)
End If
If Len(T) <> 0 Then
Intervals = Split(T, ":")
NumOfIntervals = UBound(Intervals) - LBound(Intervals) + 1
Select Case NumOfIntervals
Case 1
.Seconds = CInt(Intervals(0))
Case 2
.Minutes = CInt(Intervals(0))
.Seconds = CInt(Intervals(1))
Case 3
.Hours = CInt(Intervals(0))
.Minutes = CInt(Intervals(1))
.Seconds = CInt(Intervals(2))
End Select
End If
End With
TimeTypeFromString = udtTemp
End Function
Function TimeDifference(ByRef T1 As TimeType, ByRef T2 As TimeType) As Double
' Computes the difference of T1 - T2
' T1 and T2 are user-defined Type TimeType (Hours/Minutes/Seconds/Milliseconds)
Dim Time1 As Double
Dim Time2 As Double
With T1
Time1 = .Hours * 60 * 60 + .Minutes * 60 + .Seconds + .Milliseconds / 1000
End With
With T2
Time2 = .Hours * 60 * 60 + .Minutes * 60 + .Seconds + .Milliseconds / 1000
End With
TimeDifference = Time1 - Time2
End Function