PDA

View Full Version : Solved: Age calculation



fiza
04-02-2010, 03:59 AM
Hi Anyone!
I'm using the following afterupdate event to calculate the age when I write the date of birth. I need help to modify the code so that If a date less than a year is entered the age to be months and a date less than a week is entered it to be as days.

Private Sub txtDateOfBirth_AfterUpdate()
Dim d1 As Date
Dim d2 As Date
Dim Age As Integer
If Not IsDate(Me.txtDateofBirth.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Customer Registration"
Me.txtAge = ""
Else
d1 = CDate(Me.txtDateofBirth)
d2 = Date
Age = Year(d2) - Year(d1)
If Month(d2) < Month(d1) Or (Month(d2) = Month(d1) And Day(d2) < Day(d1)) Then
Age = Age - 1
End If
Me.txtAge = Age
End If
End Sub

Regards
fiza

Mis_Sailesh
04-02-2010, 04:34 AM
Hi,
Can you please elaborate with example?:help

fiza
04-02-2010, 04:49 AM
I have attached the sample file for your reference. You can see that after you write the date of birth in the first textbox & move to the next text box the age is displayed in it. But the text box does not say whether the age is years, months or days.

what I want is the age to be displayed in its units.

Say or example if the date of birth is 02/01/2010 I want the age to be 3months.

if its 18/01/1983 I want the text that appears in the age textbox to be 27 years.

I hope I have made my question clear.

Bob Phillips
04-02-2010, 05:39 AM
Private Sub txtDateOfBirth_AfterUpdate()
Const DATE_FORMULA As String = _
"DATEDIF(<d1>,<d2>,""Y"")&"" years ""&DATEDIF(<d1>,<d2>,""YM"")&"" months"""
Dim d1 As Date
Dim d2 As Date
Dim Age As Integer
If Not IsDate(Me.txtDateOfBirth.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Recipient Registration"
Me.txtAge = ""
Else
d1 = CDate(Me.txtDateOfBirth)
d2 = Date
Me.txtAge = Application.Evaluate(Replace(Replace(DATE_FORMULA, "<d1>", CLng(d1)), "<d2>", CLng(d2)))
End If
End Sub

GTO
04-02-2010, 05:43 AM
Probably not as good, haven't tried Bob's yet :-)


Option Explicit

Private Sub txtDateOfBirth_AfterUpdate()
Dim Period As String

If Not IsDate(Me.txtDateOfBirth.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Recipient Registration"
Me.txtAge = ""
Else
Me.txtAge = AgeCalc(CDate(Me.txtDateOfBirth), Period) & Chr(32) & Period
End If
End Sub

Function AgeCalc(DOB As Date, Period As String) As Long

Select Case Date - DOB
Case Is > 365
AgeCalc = Int((Date - DOB) / 365)
Period = IIf(AgeCalc >= 2, "Years", "Year")

Case Is > 30
AgeCalc = Int((Date - DOB) / 30)
Period = IIf(AgeCalc >= 2, "Months", "Month")
Case Is > 7
AgeCalc = Int((Date - DOB) / 7)
Period = IIf(AgeCalc >= 2, "Weeks", "Week")
Case Else
AgeCalc = Date - DOB
Period = IIf(AgeCalc >= 2, "Days", "Day")
End Select
End Function


Edit: ACK! missed a slight bit...

Mis_Sailesh
04-02-2010, 07:08 AM
Hi Fiza,
Hope you have got your solution?
If so please mark your thread as solved, else please let us know the further help you are looking at?
:help

fiza
04-02-2010, 08:51 AM
thanks for the help guys. my problem is finally solved