Re: Calculating a time and date (counting down)

Tech-Archive recommends: Fix windows errors by optimizing your registry


"Larry Serflaten" <serflaten@xxxxxxxxxxxxxx> wrote
Here is another way to skin that cat. Instead of taking the number of seconds,
it takes the interval as a data value. A bit simpler to call if you have the start
and stop times in Date variables. Plus, it allows the user to specify the units
desired in the output...

Ex: Debug.Print FormatUnits(EndTime - StartTime, "HNS", StartTime)

= 123 Hours 10 Minutes 4 Seconds

Must have been a copy/paste error somewhere, the code shown was still
being debugged, here is the final version....

Oh well!
LFS


Function FormatUnits(ByVal Period As Date, Pattern As String, Optional Start As Date) As String
' <period> - the length of time to format.
' <pattern> - the units to include. the largest unit will include all larger,
' the smallest unit will truncate all smaller. (see DateAdd for unit ID)
' <start> - the beginning date of the <period> value. (accounts for differing
' unit sizes, eg; days in a month, leap year, etc.) Default = Now
' RETURNS - Formated string containing requested units. (Absolute values)
' Output is always largest to smallest of all included units.

Dim out As String, unit As String
Dim halt As Date
Dim idx As Long, pat As Long, cnt As Long
Dim name As Variant, id As Variant

' init variables
name = VBA.Array("Years", "Quarters", "Months", "Weeks", "Days", "Hours", "Minutes", "Seconds")
id = VBA.Array("yyyy", "q", "m", "ww", "d", "h", "n", "s")
If IsMissing(Start) Then
Start = Now
End If
halt = Start + Abs(Period)

' Extract pattern
For idx = 0 To 7
If InStr(1, Pattern, Left$(id(idx), 1), vbTextCompare) Then
pat = pat Or (2 ^ idx)
End If
Next

' Build output
For idx = 0 To 7

If pat And (2 ^ idx) Then
' Include unit
unit = id(idx)

cnt = DateDiff(unit, Start, halt)
If DateAdd(unit, cnt, Start) > halt Then
cnt = cnt - 1
End If
Start = DateAdd(unit, cnt, Start)

out = out & Str(cnt) & " " & name(idx)

' Handle trailing 's' (plurals)
If cnt = 1 Then
out = Left$(out, Len(out) - 1)
End If

End If

Next

FormatUnits = out

End Function



.

Relevant Pages