Public Function basDateDiffYMD(Dt1 As Date, Optional Dt2 As Date = -1) As String
'Michael Red. 2/21/2002 DateDiff as N Years, M Months and O Days
Dim tmpAge As Integer 'Simple DateDiff w/o Birthday correction
Dim YrsCorr As Boolean 'Yr Before or After date in question
Dim MoStrt As Date 'DateTo Start coalulating the Months diff
Dim MnthCorr As Boolean 'Mnth Before or After date in question
Dim DayCorr As Boolean 'Day Before or After date in question
Dim StDt As Date 'Earliest Date of hte Pair
Dim EndDt As Date 'LatestDate of the Pair
Dim YrsDif As Long 'Number of Years between (I Know "Long" is optimistic)
Dim MnthsDif As Integer
Dim DaysDif As Integer
If (Dt2 = -1) Then 'Check for (Optional Date to Check against)
Dt2 = Date 'If Not Supplied, Assume Today
End If
If (Dt1 > Dt2) Then 'Just for MY piece of mind only do Positive diffs
StDt = Dt2
EndDt = Dt1
Else
StDt = Dt1
EndDt = Dt2
End If
YrsDif = DateDiff("YYYY", StDt, EndDt) 'Just the Years considering Jan 1, Mam
YrsCorr = DateSerial(Year(EndDt), Month(StDt), Day(StDt)) > EndDt 'Check This Year
YrsDif = YrsDif + YrsCorr 'Just Years and Correction
MoStrt = DateAdd("yyyy", YrsDif, StDt)
MnthCorr = DateSerial(Year(EndDt), Month(EndDt), Day(MoStrt)) > EndDt 'Check This Year
MnthsDif = DateDiff("m", StDt, EndDt) - YrsDif * 12 + MnthCorr
DayStrt = DateAdd("m", MnthsDif, MoStrt)
DaysDif = DateDiff("d", DayStrt, EndDt)
basDateDiffYMD = YrsDif & " Years, " & MnthsDif & " Months and " & DaysDif & " Days."
End Function
[code]
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over