Mark Whittinghill
mwhittinghill at symphonyinfo.com
Mon Aug 11 10:05:19 CDT 2003
For, the record, this is what I ended up with. It's pretty much Gustav's function, but I just tweaked it a bit on naming and minor things like that. I also made it return a variant, since there are situations where I would want it to return null.
The goal of this function is to return an age in integer years, as in my birthday is July 10, so I'm 35 on July 9, and 36 on July 10. I have been unable to make this function return an incorrect value, assuming I don't give it impossible data. If a person is born Feb 29, it uses Feb 28 for the birthday in non leap years. Works for me.
Public Function CalculateAge(varBirth As Variant, varEndDate As Variant) As Variant
'This function will calculate age from birthday
' Just using datediff rounds up a year
'Variants are used, since this is also called from queries
' Thanks to Gustav Brock, Cactus Data ApS.
On Error GoTo eh
Dim datBirth As Date
Dim datEnd As Date
If IsDate(varBirth) = False Then
CalculateAge = Null
GoTo ex
End If
If IsDate(varEndDate) = False Then
CalculateAge = Null
GoTo ex
End If
datBirth = CDate(varBirth)
datEnd = CDate(varEndDate)
CalculateAge = CalculateYears(datBirth, datEnd)
ex:
Exit Function
eh:
CalculateAge = -999
Resume ex
End Function
Public Function CalculateYears(ByVal datDate1 As Date, ByVal datDate2 As Date) As Integer
' Returns the difference in full years between datDate1 and datDate2.
'
' Calculates correctly for:
' negative differences
' leap years
' dates of 29. February
' date/time values with embedded time values
' negative date/time values (prior to 1899-12-29)
'
' Thanks toGustav Brock, Cactus Data ApS.
On Error GoTo eh
' Constants for leap year calculation. Last normal date of February.
Const cbytFebMonth As Byte = 2
Const cbytFebLastDay As Byte = 28
' Maximum number of days in a month.
Const cbytMonthDaysMax As Byte = 31
Dim intYears As Integer
Dim intDaysDiff As Integer
Dim intReversed As Integer
intYears = DateDiff("yyyy", datDate1, datDate2)
If intYears = 0 Then
' Both dates fall within the same year.
Else
' Check for ultimo February and leap years.
If (Month(datDate1) = cbytFebMonth) And (Month(datDate2) = cbytFebMonth) Then
' Both dates fall in February.
' Check if dates are at ultimo February.
If (Day(datDate1) >= cbytFebLastDay) And (Day(datDate2) >= cbytFebLastDay) Then
' Both dates are at ultimo February.
' Check if the dates fall in leap years.
If Day(DateSerial(Year(datDate1), cbytFebMonth + 1, 0)) = cbytFebLastDay Xor _
Day(DateSerial(Year(datDate2), cbytFebMonth + 1, 0)) = cbytFebLastDay Then
' Only one date falls within a leap year.
' Adjust both dates to day 28 of February.
datDate1 = DateAdd("d", cbytFebLastDay - Day(datDate1), datDate1)
datDate2 = DateAdd("d", cbytFebLastDay - Day(datDate2), datDate2)
Else
' Both dates fall either in leap years or non leap years.
' No adjustment needed.
End If
End If
End If
' Calculate day difference using months and days as Days() will fail when
' comparing leap years with non leap years for dates after February.
intDaysDiff = (Month(datDate1) * cbytMonthDaysMax + Day(datDate1)) - (Month(datDate2) * cbytMonthDaysMax + Day(datDate2))
intReversed = Sgn(intYears)
' Decrease count of years by one if dates are closer than one year.
intYears = intYears + (intReversed * ((intReversed * intDaysDiff) > 0))
End If
CalculateYears = intYears
ex:
Exit Function
eh:
CalculateYears = -999
Resume ex
End Function
Mark Whittinghill
Symphony Information Services
612-333-1311
mwhittinghill at symphonyinfo.com
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://databaseadvisors.com/pipermail/accessd/attachments/20030811/b83d1517/attachment-0001.html>