This should do the trick for you!
Post another note if you need help getting this to work for you.
Option Explicit
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, _
ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
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.
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' Requires:
' GetTimeDelimiter
' In:
' dtmStart:
' starting date for the interval, including a time portion
' datend:
' ending date for the interval, including a time portion
' strFormat (optional):
' format specifier, as shown below. (Default: "H:MM:SS"
' Out:
' Return Value:
' The formatted time difference.
' Comment:
' Due to the way the calculations are performed, the largest interval
' is 68 years or so.
' Example:
' Using #1/1/97 12:00 PM# and #1/4/97 2:45:45 PM# as the dates, and one
' of the following format templates,
' dhFormatInterval(#1/1/97 12:00 PM#, #1/4/97 2:45:45 PM#, "<format>"
' will return (using each of the following format strings):
' 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)
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 (leading 0 on minutes, if necessary)
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 (leading 0 on seconds, if necessary)"
strOut = lngFullMinutes & strDelim & _
Format(intSeconds, "00"
Case Else
strOut = ""
End Select
dhFormatInterval = strOut
End Function
Private Function GetTimeDelimiter() As String
' Retrieve the time delimiter from, believe it or not,
' WIN.INI. This is the only reasonable solution
' to this problem, even in this day and age!
' Used by:
' dhCTimeStr
' dhFormatInterval
' Requires:
' GetProfileString declaration
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
Const conMaxSize = 10
Dim strBuffer As String
Dim intLen As Integer
strBuffer = Space(conMaxSize)
intLen = GetProfileString("intl", "sTime", "", strBuffer, conMaxSize)
GetTimeDelimiter = Left(strBuffer, intLen)
End Function
