M
MaRSMAN
This code I tested and works I would like to expand this to return the age
to include Days ex 59 years, 10 months, 25 Days
Would someone please ad the addition code for me.
In most humble thanks marsman
Option Compare Database
Option Explicit
'*************************************************************
' FUNCTION NAME: Age()
'
' PURPOSE:
' Calculates age in years from a specified date to today's date.
'
' INPUT PARAMETERS:
' varBirthDate: 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 Date < 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:
' varBirthDate: a birth date.
'
' RETURN
' Months since the last birthday.
'*************************************************************
Function AgeMonths(ByVal varBirthDate As Variant) As Integer
If IsNull(varBirthDate) Then AgeMonths = 0: Exit Function
Dim tAge As Double
tAge = (DateDiff("m", varBirthDate, Now))
If (DatePart("d", varBirthDate) > 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
to include Days ex 59 years, 10 months, 25 Days
Would someone please ad the addition code for me.
In most humble thanks marsman
Option Compare Database
Option Explicit
'*************************************************************
' FUNCTION NAME: Age()
'
' PURPOSE:
' Calculates age in years from a specified date to today's date.
'
' INPUT PARAMETERS:
' varBirthDate: 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 Date < 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:
' varBirthDate: a birth date.
'
' RETURN
' Months since the last birthday.
'*************************************************************
Function AgeMonths(ByVal varBirthDate As Variant) As Integer
If IsNull(varBirthDate) Then AgeMonths = 0: Exit Function
Dim tAge As Double
tAge = (DateDiff("m", varBirthDate, Now))
If (DatePart("d", varBirthDate) > 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