Vista - Date duration function that returns years, months, weeks and days?

"HAL07" <yahoohal@xxxxxx> wrote

See if this helps....

LFS


Public Sub DateIntervals(ByVal Date1 As Date, ByVal Date2 As Date, ParamArray Prams())
Dim swap As Date, test As Date
Dim i As Long, itr As String
Const interval = "mdhns"
' Returns the greatest full interval (yr, mo, day, hr, min, sec) between two dates
' Calling procedure supplies variable(s) for the desired interval(s)

' Ex1: DateIntervals Birthday, Now, Yr, Mo, Dy, Hr, Mn, Sec
' (Exactly how old are you?)

' Ex2: DateIntervals Now, "25 Dec", , , Days
' (How many days until Christmas?)

If UBound(Prams) < 0 Then Exit Sub

If (DateValue(Date1) = 0) Xor (DateValue(Date2) = 0) Then
' Assume today if one is a time and the other is a date...
If DateValue(Date1) = 0 Then Date1 = Date1 + DateValue(Now)
If DateValue(Date2) = 0 Then Date2 = Date2 + DateValue(Now)
End If

If Date1 > Date2 Then
' Swap dates if first is after second...
swap = Date1
Date1 = Date2
Date2 = swap
End If

If Not IsMissing(Prams(0)) Then
' Adjust year values
Prams(0) = Year(Date2) - Year(Date1)
test = DateAdd("yyyy", Prams(0), Date1)
Prams(0) = Prams(0) + (test > Date2)
Date1 = DateAdd("yyyy", Prams(0), Date1)
If UBound(Prams) < 1 Then Exit Sub
End If

For i = 1 To IIf(UBound(Prams) > 5, 5, UBound(Prams))
' Adjust remaining values
If Not IsMissing(Prams(i)) Then
itr = Mid$(interval, i, 1)
Prams(i) = DateDiff(itr, Date1, Date2)
Prams(i) = Prams(i) + (DateAdd(itr, Prams(i), Date1) > Date2)
Date1 = DateAdd(itr, Prams(i), Date1)
End If
Next i
End Sub

Larry Serflaten wrote:This is a VB/VBA function that will not work in vbscript - along with
the obvious flaw of assigning datatypes to the arguments and variables
(all variables are Variant in vbscript so the "As Date" is not allowed),
there is no ParamArray keyword in vbscript; so HALO7, you will need to
rewrite this to get around those limitations.
--
HTH,
Bob Barrows

Larry Serflaten wrote:OK, I was bored so I created a vbscript version of this:

'initialize all the argument variables keeping in mind that there are no
optional arguments in vbscript procedures.
Birthday=#5/18/1975 09:00#
Yr=0 ' 0 or greater says "calculate this value"
Mo=0
Dy=0
Wk=0
Hr=0
Mn=-1 ' -1 says "don't calculate this value"
Sec=0
DateIntervals Birthday, Now, Yr, Mo,Wk, Dy, Hr, Mn, Sec
msgbox "You are " & Yr & " years, " & Mo & " months, " & _
Wk & " weeks, " & Dy & " days, " & Hr & " hours and " & _
Sec & " seconds old"

Public Sub DateIntervals(ByVal Date1, ByVal Date2, Yr, _
Mo,Wk, Dy, Hr, Mn, Sec)
Dim swap, test
Dim i, itr
Const interval = "ymwdhns"
' Returns the greatest full interval (yr, mo, day, hr, min, sec) between
two dates
' Calling procedure supplies variable(s) for the desired interval(s)

Prams=Array(Yr, Mo, Wk,Dy, Hr, Mn, Sec)

If (DateValue(Date1) = 0) Xor (DateValue(Date2) = 0) Then
' Assume today if one is a time and the other is a date...
If DateValue(Date1) = 0 Then Date1 = Date1 + DateValue(Now)
If DateValue(Date2) = 0 Then Date2 = Date2 + DateValue(Now)
End If

If Date1 > Date2 Then
' Swap dates if first is after second...
swap = Date1
Date1 = Date2
Date2 = swap
End If

For i = 0 To UBound(Prams)
If Prams(i) > -1 Then
itr = Mid(interval, i+1, 1)
itr=replace(replace(itr,"w","ww"),"y","yyyy")
' itr=replace(itr,"y","yyyy")
Prams(i) = DateDiff(itr, Date1, Date2)
Prams(i) = Prams(i) + (DateAdd(itr, Prams(i), Date1) > Date2)
Date1 = DateAdd(itr, Prams(i), Date1)
End If
Next 'i
Yr=Prams(0)
Mo=Prams(1)
Wk=Prams(2)
Dy=Prams(3)
Hr=Prams(4)
Mn=Prams(5)
Sec=Prams(6)

End Sub

--
HTH,
Bob Barrows

"Bob Barrows" <reb01501@xxxxxx> wrote
With a little help from friends, he got something useable....

Good job!
LFS

I'll say it too, nice job on the function!
--
Jeff C
Live Well .. Be Happy In All You Do


"Bob Barrows" wrote:

"Pegasus [MVP]" <news@xxxxxx> wrote in message
news:%23UgHkGM%23JHA.4900@xxxxxxYou are right. I was wrong. In my slightly warped mind, DateDiff equates
to subtracting two date type variables, when in reality, they are two
different things. Thanks for straightening me out.

-Paul Randall

Hal, be aware that doing this to the second is going to give you bogus
results. For example, given the 1980 birthdate to the second, strict
calculations will now be off by 16 seconds due to insertions of leap seconds
(which by definition, will not be accounted for in duration calculations
using the straightforward differences of two dates/times):

http://tycho.usno.navy.mil/leapsec.html

However, this is still arguably _legitimate_ even for precise usage since
circadian cycle is a significant part of the meaning of measures like this.

"HAL07" <yahoohal@xxxxxx> wrote in message
news:OOjg8bI#JHA.4692@xxxxxx

Bob Barrows wrote:
Thank you very much Larry

--
-- HAL07, Engineering Services, Norway

On Jun 30, 3:44*am, "Alex K. Angelopoulos" <alex(dot) k(dot again)
angelopoulos(at)gmail.com> wrote:The number of elapsed seconds depends upon the jurisdiction
http://www.ucolick.org/~sla/leapsecs/epochtime.html
It is beyond the scope of most software to make the policy decision
that international governments have not done in a consistent fashion.