CODEWITHSUNDEEP
vba
Leon the Logician
Leon the Logician

Reputation: 308

Computing & Evaluating Negative Time Values in VBA

I am new to VBA and have encountered an issue.
My objective is to find an elegant way of evaluating negative time values.

For example, the body of code below generates a message box which displays 12:30:00 AM. I would expect it to display 11:30:00 PM. 

Sub Main() 'Run Test
Dim difference As Date
    difference = #12:00:00 AM# - #12:30:00 AM#
    MsgBox difference
End Sub

I have created a solution to this issue, but would like to know the coding community's feedback.
Some of the code is not necessary, but I have written it for functionality that may be important in the future.

The run sub routine allows you to run the test function with your specified values.
The test function tests the timeDiff & timeSum logic.
The timeDiff function finds the time-difference between t1 and t0.
The timeSum function finds the time-sum of t1 and t0.
The asDuration function removes the AM/PM suffix from a time value.
The asMilitary function converts 12-hour format to 24 hour-format.
The concat function I created to more easily concatenate strings.

Sub Main() 'Run Test
    MsgBox Test("0:29:0", "23:30:0")
End Sub


Function Test(startT As Date, endT As Date) 'Test timeDiff & timeSum logic
    Dim nextShift As Date, prevShift As Date, hours As Date

    hours = timeDiff(endT, startT)
    prevShift = timeDiff(startT, "0:30:0")
    nextShift = timeSum("0:30:0", endT)        

    Test = concat("Start -", startT, "", "End - ", endT, "", "Duration -", asDuration(hours), "", "Next Shift: ", nextShift, "", "Prev Shift: ", prevShift)
End Function


Function timeDiff(t1 As Date, t0 As Date) As Date 'Return Time1 minus Time0
    Dim units(0 To 2) As String

    units(0) = Hour(t1) - Hour(t0)
    units(1) = Minute(t1) - Minute(t0)
    units(2) = Second(t1) - Second(t0)

    If units(2) < 0 Then
        units(2) = units(2) + 60
        units(1) = units(1) - 1
    End If

    If units(1) < 0 Then
        units(1) = units(1) + 60
        units(0) = units(0) - 1
    End If

    units(0) = IIf(units(0) < 0, units(0) + 24, units(0))
    timeDiff = Join(units, ":")
End Function


Function timeSum(t1 As Date, t0 As Date) As Date 'Return Time1 plus Time0
    Dim units(0 To 2) As String

    units(0) = Hour(t1) + Hour(t0)
    units(1) = Minute(t1) + Minute(t0)
    units(2) = Second(t1) + Second(t0)

    If units(2) >= 60 Then
        units(2) = units(2) Mod 60
        units(1) = units(1) + 1
    End If

    If units(1) >= 60 Then
        units(1) = units(1) Mod 60
        units(0) = units(0) + 1
    End If

    units(0) = IIf(units(0) >= 24, units(0) Mod 24, units(0))
    timeSum = Join(units, ":")
End Function


Function asDuration(time As Date) As String 'Display as duration; Remove AM/PM suffix from time
    time = asMilitary(time)
    asDuration = Left(time, Len(time))
End Function


Function asMilitary(time As Date) As String 'Convert 12-hour format to 24-hour-format
    asMilitary = Hour(time) & ":" & Minute(time) & ":" & Second(time)
End Function


Function concat(ParamArray var() As Variant) As String 'Return arguments of function call concatenated as a single string
    For Each elem In var()
        concat = IIf(elem <> "", concat & elem & " ", concat & vbNewLine)
    Next
End Function

Upvotes: 1

Views: 1838

Answers (2)

Leon the Logician
Leon the Logician

Reputation: 308

Option Compare Database
Sub Main() 'Run Test
    MsgBox Test("00:29:00", "23:30:00")
End Sub

Function Test(startT As Date, endT As Date) 'Test timeDiff logic
    Dim nextShift As Date, prevShift As Date, hours As Date

    hours = timeDiff(endT, startT)
    prevShift = timeDiff(startT, "0:30:0")
    nextShift = timeDiff("0:30:0", endT)

    Test = concat("Start -", startT, "", "End - ", endT, "", "Duration -", asDuration(hours), "", "Next Shift: ", nextShift, "", "Prev Shift: ", prevShift)
End Function


Function timeDiff(t1 As Date, t0 As Date) As Date 'Returns t1-t0
    dayAnchor = #1/1/2015#
    timeDiff = ((dayAnchor + TimeValue(t1)) - TimeValue(t0)) - dayAnchor
End Function

Function asDuration(time As Date) As String 'Display as duration; Remove AM/PM suffix from time
    t = Hour(time) & ":" & Minute(time) & ":" & Second(time)
    asDuration = Left(t, Len(t))
End Function

Function concat(ParamArray var() As Variant) As String 'Return arguments of function call concatenated as a single string
    For Each elem In var()
        concat = IIf(elem <> "", concat & elem & " ", concat & vbNewLine)
    Next
End Function

Upvotes: 0

PeterT
PeterT

Reputation: 8557

It turned out to be a bit trickier than my initial tests. Just typing into the immediate window of the VBA Editor allowed me to work several items by hand that the Editor "intelligently corrected" for me. But the underlying solution remains the same in any case.

The key is to "anchor" your time value on a date -- any date will do because it will be subtracted away later. But this makes your math work out as expected.

Option Explicit

Sub test()
    Debug.Print TimeDiff("12:00:00", "00:30:00")
    Debug.Print TimeDiff("0:29:0", "23:30:0")
    Debug.Print TimeDiff("16:00:00", "4:30:00")
End Sub

Function TimeDiff(t1 As Date, t0 As Date) As Date
    '--- returns t1-t0

    Dim d1 As Date
    Dim dayAnchor As Date

    dayAnchor = #1/1/2015#
    d1 = dayAnchor + t1
    TimeDiff = (d1 - t0) - dayAnchor
End Function

Upvotes: 2

Related Questions