Re: Calculating a time and date (counting down)


"Bobzter100" <Bobzter100@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote
Many thnaks to you guys for providing the solution to my VB issue. In the
end, i used Rick's (mainly because it was the most straightforward to
undertake).

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

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. Output is always
' largest to smallest of all included units. (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)

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

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

' Extract pattern
For Each unit In id
If InStr(1, Pattern, Left$(unit, 1), vbTextCompare) Then
pat = pat Or (2 ^ idx)
End If
idx = idx + 1
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