Calculate a person's age

Instructions: Copy the declarations and code below and paste directly into your VB project

Declarations:
Const ERR_INVALID_DATE = 20000

Const ERR_INVALID_DATE_MSG = "Date Required"

Code:

'PURPOSE: Calculates a person's age

'PARAMETERS:  

' BirthDate: the person's birthdate, in date or string format
'RelativeTo (Optional) the "as of" date.  If not specified, the 
'current date is used 

'RETURNS: The person's age as of the date specified in 
'RelativeTo, or as of the current date if RelativeTo isn't
'specified.

Public Function Age(BirthDate As Variant, _ 
Optional RelativeTo As Variant) As Integer

Dim dBDate As Date, dRelDate As Date
Dim bSubtractOne As Boolean
Dim iAns As Integer

If IsMissing(RelativeTo) Then
    RelativeTo = Now
ElseIf Not IsDate(RelativeTo) Then
    err.Raise ERR_INVALID_DATE, , ERR_INVALID_DATE_MSG
End If

If Not IsDate(BirthDate) Then err.Raise ERR_INVALID_DATE, , _
ERR_INVALID_DATE_MSG


dBDate = CDate(BirthDate)
dRelDate = CDate(RelativeTo)
iAns = Year(dRelDate) - Year(dBDate)

If Month(dBDate) <> Month(dRelDate) Then
    bSubtractOne = Month(dBDate) > Month(dRelDate)
Else
    bSubtractOne = Day(dBDate) > Day(dRelDate)
End If

    If bSubtractOne Then iAns = iAns - 1
    Age = iAns


End Function


No comments: