View Full Version : Calculate A Person's Age


Mile-O
11-23-2005, 01:37 AM
Copy the following function into a new module:

Public Function Age(dteDOB As Date, Optional SpecDate As Variant) As Integer
Dim dteBase As Date, intCurrent As Date, intEstAge As Integer
If IsMissing(SpecDate) Then
dteBase = Date
Else
dteBase = SpecDate
End If
intEstAge = DateDiff("yyyy", dteDOB, dteBase)
intCurrent = DateSerial(Year(dteBase), Month(dteDOB), Day(dteDOB))
Age = intEstAge + (dteBase < intCurrent)
End Function

With this function you can calculate a person's age properly. It can also work two ways:

Calculate a person's age as at today
Calculate a person's age as at a specific date


For these 2 options, call the function like so:


Age([DOB])
Age([DOB], [SpecificDate])

ozinm
11-23-2005, 05:29 AM
Hi all,
I don't know if this is any better or worse but I put together a couple of functions to do the same sort of thing.
These work out the age in years and months.
Might be useful :confused: ?

'************************************************* ************
' FUNCTION NAME: Age()
'
' PURPOSE:
' Calculates age in years from a specified date to today's date.
'
' INPUT PARAMETERS:
' StartDate: The beginning date (for example, a birth date).
'
' RETURN
' Age in years.
'
'************************************************* ************
Function Age(varBirthDate As Variant) As Integer
Dim varAge As Variant


If IsNull(varBirthDate) Then Age = 0: Exit Function

varAge = DateDiff("yyyy", varBirthDate, Now)
If Now < DateSerial(Year(Now), Month(varBirthDate), Day(varBirthDate) _
) Then
varAge = varAge - 1
End If
Age = CInt(varAge)
End Function

'************************************************* ************
' FUNCTION NAME: AgeMonths()
'
' PURPOSE:
' Compliments the Age() function by calculating the number of months
' that have expired since the last month supplied by the specified date.
' If the specified date is a birthday, the function returns the number of
' months since the last birthday.
'
' INPUT PARAMETERS:
' StartDate: The beginning date (for example, a birthday).
'
' RETURN
' Months since the last birthday.
'************************************************* ************
Function AgeMonths(ByVal StartDate As String) As Integer
Dim tAge As Double
If IsNull(StartDate) Then AgeMonths = 0: Exit Function
tAge = (DateDiff("m", StartDate, Now))
If (DatePart("d", StartDate) > DatePart("d", Now)) Then
tAge = tAge - 1
End If
If tAge < 0 Then
tAge = tAge + 1
End If

AgeMonths = CInt(tAge Mod 12)

End Function

y2jasminej
07-27-2006, 10:25 AM
I did this...not perfect I think, but good enough for my needs. :)

I created an unbound text box on my form with this as the control source:

=DateDiff("yyyy",[DOB],Now())+Int(Format(Now(),"mmdd")<Format([DOB],"mmdd"))

Since I didn't need to save the age anywhere, just look at it, it works for me and maybe for others. :D