Option Explicit
'Assumes Range2 is greater than Range1
Public Function Subtract2Values(Range1 As Variant, Range2 As Variant) As Variant
Dim Day1 As Long, Day2 As Long
Dim Time1 As Date, Time2 As Date
Dim Value1 As String, Value2 As String, ReturnValue As String
'Must be 2 ranges or 2 string values in format specified
If GetData(Range1, Value1, Time1, Day1) Then
If GetData(Range2, Value2, Time2, Day2) Then
Day2 = Day2 - Day1
If Time2 > Time1 Then
Time2 = Time2 - Time1
Else
Day2 = Day2 - 1
Time2 = Time1 - Time2
End If
'Prefix a space for next test
ReturnValue = Format(Day2, " 00:") & Format(Time2, "hh:mm")
ReturnValue = Replace$(ReturnValue, " 0", vbNullString)
End If
End If
Debug.Print ReturnValue
Subtract2Values = ReturnValue
End Function 'Subtract2Values
Private Function GetData(aRange As Variant, _
ByRef aValue As String, _
ByRef aTime As Date, _
ByRef aDay As Long) As Boolean
Dim TempDate As Date
Dim TempText As String
'Must be range or string value in format specified
If TypeName(aRange) = "Range" Then
aValue = aRange.Text
ElseIf TypeName(aRange) = "String" Then
aValue = aRange.Text
ElseIf TypeName(aRange) = "Date" Then
aValue = aRange.Text
Else
Exit Function
End If
'Simple check for correct format
If InStr(aValue, ":") = 0 Then
Exit Function
ElseIf InStr(aValue, ":") = InStrRev(aValue, ":") Then
Exit Function
End If
TempText = Mid$(aValue, InStr(aValue, ":") + 1)
On Error Resume Next
TempDate = TimeValue(TempText)
If Err.Number = 0 Then
aTime = TempDate
aDay = Val(Left$(aValue, InStr(aValue, ":") - 1))
End If
If IsObject(aRange) Then
Debug.Print aRange.Address, aValue, aTime, aDay
Else
Debug.Print aRange, aValue, aTime, aDay
End If
GetData = (Err.Number = 0)
Err.Clear
On Error GoTo 0
End Function 'GetData
