Formatting Elapsed Time

[sukishan]

Formatting Elapsed Time
VBA provides no support for elapsed times or for displaying formatted elapsed times. You'll have to take steps on your own if you want to take two dates, find the difference between them, and display the difference formatted the way you want it. The function in this section, dhFormatInterval, in Listing 2.24 (certainly the longest procedure in this chapter), allows you to specify two dates and an optional format specifier and returns a string representing the difference. As the function is currently written, you can use any of the format specifiers listed in Table 2.9. You are invited, of course, to add your own specifiers to the list by modifying the source code. (For information on retrieving the time delimiter programmatically, see the section "Formatting Cumulative Times" later in this chapter.)

Available Format Specifications for dhFormatInterval

Format                     Example
D H                         3 Days 3 Hours
D H M                      3 Days 2 Hours 46 Minutes
D H M S                   3 Days 2 Hours 45 Minutes 45 Seconds
D H:MM                    3 Days 2:46
D HH:MM                 3 Days 02:46
D HH:MM:SS            3 Days 02:45:45
H M                         74 Hours 46 Minutes
H:MM                      74:46 (leading 0 on minutes, if necessary)
H:MM:SS                 74:45:45
M S                         4485 Minutes 45 Seconds
M:SS                      4485:45 (leading 0 on seconds, if necessary)
Listing 2.24: Format the Interval between Two Dates

Function dhFormatInterval(dtmStart As Date, datend As Date, _
Optional strFormat As String = "H:MM:SS") As String
    ' Return the difference between two times,
    ' formatted as specified in strFormat.
    Dim lngSeconds As Long
    Dim sngMinutes As Single
    Dim sngHours As Single
    Dim sngDays As Single
    Dim intSeconds As Integer
    Dim intMinutes As Integer
    Dim intHours As Integer
    Dim intRoundedHours As Integer
    Dim intRoundedMinutes As Integer
    Dim strDay As String
    Dim strHour As String
    Dim strMinute As String
    Dim strSecond As String
    Dim strOut As String
    Dim lngFullDays As Long
    Dim lngFullHours As Long
    Dim lngFullMinutes As Long
    Dim strDelim As String
    ' If you don't want to use the local delimiter,
    ' but a specific one, replace the next line with
    ' this:
    ' strDelim = ":"
    strDelim = GetTimeDelimiter()
    ' Calculate the full number of seconds in the interval.
    ' This limits the calculation to 2 billion seconds
    ' (68 years or so), but that's not too bad. Then calculate
    ' the difference in minutes, hours, and days, as well.
    lngSeconds = DateDiff("s", dtmStart, datend)
    sngMinutes = lngSeconds / 60
    sngHours = sngMinutes / 60
    sngDays = sngHours / 24
    ' Get the full hours and minutes, for later display.
    lngFullDays = Int(sngDays)
    lngFullHours = Int(sngHours)
    lngFullMinutes = Int(sngMinutes)

    ' Get the incremental amount of each unit.
    intHours = Int((sngDays - lngFullDays) * 24)
    intMinutes = Int((sngHours - lngFullHours) * 60)
    intSeconds = CInt((sngMinutes - lngFullMinutes) * 60)
    ' In some instances, time values must be rounded.
    ' The next two lines depend on the fact that a true statement
    ' has a value of -1 and a false statement has a value of 0.
    ' The code needs to add 1 to the value if the following
    ' expression is true, and 0 if not.
    intRoundedHours = intHours - (intMinutes > 30)
    intRoundedMinutes = intMinutes - (intSeconds > 30)
    strDay = "Days"
    strHour = "Hours"
    strMinute = "Minutes"
    strSecond = "Seconds"
    If lngFullDays = 1 Then strDay = "Day"
    Select Case strFormat
        Case "D H"
            If intRoundedHours = 1 Then strHour = "Hour"
            strOut = lngFullDays & " " & strDay & " " & _
             intRoundedHours & " " & strHour
        Case "D H M"
            If intHours = 1 Then strHour = "Hour"
            If intRoundedMinutes = 1 Then strMinute = "Minute"
            strOut = lngFullDays & " " & strDay & " " & _
             intHours & " " & strHour & " " & _
             intRoundedMinutes & " " & strMinute
        Case "D H M S"
            If intHours = 1 Then strHour = "Hour"
            If intMinutes = 1 Then strMinute = "Minute"
            If intSeconds = 1 Then strSecond = "Second"
            strOut = lngFullDays & " " & strDay & " " & _
             intHours & " " & strHour & " " & _
             intMinutes & " " & strMinute & " " & _
             intSeconds & " " & strSecond
        Case "D H:MM"      ' 3 Days 2:46"
            strOut = lngFullDays & " " & strDay & " " & _
             intHours & strDelim & Format(intRoundedMinutes, "00")
        Case "D HH:MM"     ' 3 Days 02:46"
            strOut = lngFullDays & " " & strDay & " " & _
             Format(intHours, "00") & strDelim & _
             Format(intRoundedMinutes, "00")
        Case "D HH:MM:SS"  ' 3 Days 02:45:45"
            strOut = lngFullDays & " " & strDay & " " & _
             Format(intHours, "00") & strDelim & _
             Format(intMinutes, "00") & strDelim & _
             Format(intSeconds, "00")
        Case "H M"         ' 74 Hours 46 Minutes"
            If lngFullHours = 1 Then strHour = "Hour"
            If intRoundedMinutes = 1 Then strMinute = "Minute"
            strOut = lngFullHours & " " & strHour & " " & _
             intRoundedMinutes & " " & strMinute
        Case "H:MM"        ' 74:46
            strOut = lngFullHours & strDelim & _
             Format(intRoundedMinutes, "00")
        Case "H:MM:SS"     ' 74:45:45
            strOut = lngFullHours & strDelim & _
             Format(intMinutes, "00") & strDelim & _
             Format(intSeconds, "00")
        Case "M S"         ' 4485 Minutes 45 Seconds
            If lngFullMinutes = 1 Then strMinute = "Minute"
            If intSeconds = 1 Then strSecond = "Second"
            strOut = lngFullMinutes & " " & strMinute & " " & _
             intSeconds & " " & strSecond
        Case "M:SS"        ' 4485:45
            strOut = lngFullMinutes & strDelim & _
             Format(intSeconds, "00")
        Case Else
            strOut = ""
    End Select
    dhFormatInterval = strOut
End FunctionFor example, to test out the function, you might write a test routine like the sample shown in Listing 2.25. This sample exercises all the predefined format specifiers.

Listing 2.25: Test Routine for dhFormatInterval

Sub TestInterval()
    Dim dtmStart As Date
    Dim dtmEnd As Date
    dtmStart = #1/1/97 12:00:00 PM#
    dtmEnd = #1/4/97 2:45:45 PM#
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H M")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H M S")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H:MM")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D HH:MM")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D HH:MM:SS")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H M")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H:MM")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H:MM:SS")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "M S")
    Debug.Print dhFormatInterval(dtmStart, dtmEnd, "M:SS")
End SubLet's face it: the dhFormatInterval function defines the term brute force. Although we attempted to make this routine as simple as possible, it requires several steps to provide all this flexibility.

How does it work? The function first calculates the difference between the two dates in seconds and then calculates the total number of days, hours, minutes, and seconds. In addition, it calculates the number of leftover hours, minutes, and seconds so it can display those, too. Finally, it also calculates rounded values for hours and minutes. That way, if you choose not to display seconds, the minutes value will be rounded accordingly. The same goes for hours: if you decide not to display minutes, the hours value must be rounded to the nearest full hour. Once the routine has those values, it uses a large Select Case statement to determine which type of output string to create and takes the steps to create the correct result.

Because dhFormatInterval calculates the difference between the two dates in seconds and places that value in a long integer, you're limited to around 68 years between the two dates. Most likely that won't be a terrible limitation, but you should be aware of it before using this function in a production application.