Public Function FmtTime(ByVal pTime As Double, _
Optional ByVal pInUnits As String = "Secs", _
Optional ByVal pDP As Byte = 1, _
Optional ByVal pNegOK As Boolean = False) As String
Const MaxSec As Double = 60 'Cutoff for converting over to minutes
Const MaxMin As Double = 60 'Cutoff for converting over to hours
Const MaxHrs As Double = 24 'Cutoff for converting over to days
Const MaxDys As Double = 14 'Cutoff for converting over to weeks
Const MaxWks As Double = 52 'Cutoff for converting over to years
Dim OutTime As Double 'The working time value
Dim temp As Double 'Temporary time variable
' Check for negative time
If pTime < 0 Then 'If the time is negative,
If Not pNegOK Then 'And that is not OK,
FmtTime = CVErr(xlErrValue) 'Return a Value error
Exit Function
End If
End If
OutTime = Abs(pTime) 'Convert to positive for formatting
'Convert everything to seconds
Select Case UCase(pInUnits) 'Process the pInUnits argument
Case "S", "SEC", "SECS", "SECOND", "SECONDS" 'If in seconds, no conversion
Case "M", "MIN", "MINS", "MINUTE", "MINUTES" 'If in minutes,
OutTime = OutTime * 60 'Convert to seconds
Case "H", "HRS", "HOUR", "HOURS" 'If in hours,
OutTime = OutTime * 60 * 60 'Convert to seconds
Case "D", "DYS", "DAY", "DAYS" 'If in days,
OutTime = OutTime * 60 * 60 * 24 'Convert to seconds
Case "W", "WKS", "WEEK", "WEEKS" 'If in weeks,
OutTime = OutTime * SecsPerWeek 'Convert to seconds
Case "Y", "YRS", "YEAR", "YEARS" 'If in years,
OutTime = OutTime * SecsPerYear 'Convert to seconds
Case Else 'If none on the above.
FmtTime = CVErr(xlErrValue) 'Return Value error
Exit Function
End Select
'Will it be seconds?
temp = Round(OutTime, pDP) 'Round to specified decimal places
If temp < MaxSec Then 'If < max secs, do it in seconds
FmtTime = FormatNumber(OutTime, pDP) & " sec"
GoTo Done
End If
'Will it be minutes?
OutTime = OutTime / 60 'Convert from seconds to minutes
temp = Round(OutTime, pDP) 'Round to specified decimal places
If temp < MaxMin Then 'If < max mins, do it in minutes
FmtTime = FormatNumber(OutTime, pDP) & " min"
GoTo Done
End If
'Will it be hours?
OutTime = OutTime / 60 'Convert from minutes to hours
temp = Round(OutTime, pDP) 'Round to specified decimal places
If temp < MaxHrs Then 'If < max hours, do it in hours
FmtTime = FormatNumber(OutTime, pDP) & " hrs"
GoTo Done
End If
'Will it be days?
OutTime = OutTime / 24 'Convert from hours to days
temp = Round(OutTime, pDP) 'Round to specified decimal places
If temp < MaxDys Then 'If < max days, do it in days
FmtTime = FormatNumber(OutTime, pDP) & " dys"
GoTo Done
End If
'Will it be weeks?
OutTime = OutTime / 7 'Convert from days to weeks
temp = Round(OutTime, pDP) 'Round to specified decimal places
If temp < MaxWks Then 'If < max weeks, do it in weeks
FmtTime = FormatNumber(OutTime, pDP) & " wks"
GoTo Done
End If
'It has to be years
OutTime = OutTime / 365 'Convert it to years
FmtTime = FormatNumber(OutTime, pDP) & " yrs"
Done:
If pTime < 0 Then FmtTime = "-" & FmtTime 'If it was negative, add negative sign
End Function
