1. Registered User
Join Date
Feb 2009
Posts
19

Halo pro...This question maybe being asked for hundreds of time. But yet, still i've to ask it again.

Assume that i've a set of DOB (Date of birth) data. With vba help, it will display (not save on table) the actual age of a person.

---Scenario----

Let say i input data of DOB. With vba help it will generate a set of data : Year / Month / Day.

Data input = 25 / 07 / 1982

Vba Help :

Age = Year | Month | Day | (Display Only)

--i hope pro reply with a sample. TQ

Join Date
Nov 2004
Location
out on a limb
Posts
13,692
Code:
```Public Function CalcAge(aDoB As Date, index As Integer, Optional TriggerDate As Date) As Single
'this function returns various elements of an age based on the supplied DoB
'these elements are
'1: the age expressed as a decimal value of years
'2: the age in years
'3: the month
'4: the days
'... all based on the optional supplied trigger date
'if no trigger date is supplied then the function uses todays date
'do we especially care about "negative" ages (ie where a triggerdate is less than the supplied dateofbirth?
'hell no, its not my function, I don't care
If IsNull(TriggerDate) Then TriggerDate = Date
Dim Age As Single
Select Case index
Case Is = 1 'the we return the single value/representation of the years as decimal
CalcAge = Age / 365.25
Case Is = 2 'then we return the years as an integer
CalcAge = Fix(Age / 365.25)
Case Is = 3 'then we return the months as integer
CalcAge = CInt((Age / 365.25 - Fix(Age / 365.25)) * 12)
Case Is = 4 'then we return the days as integer
'first off cal the number of years
Dim NoYears As Single
Dim NoMonths As Single
NoYears = Fix(Age / 365.25)
NoMonths = CInt((Age / 365.25 - Fix(Age / 365.25)) * 12)
CalcAge = CInt((Age / 365.25 - NoMonths / 12 - 49) * 365.25)
'CalcAge = Age - Fix(Age / 365.25) - CInt((Age / 365.25 - Fix(Age / 365.25)))
'will need to handle if either the Dob was before a leap year Feb 29
'or
'the trigger date is 'after' a leap year Feb 29
'however I have neither the time or inclination to do so here
'  CalcAge = CalcAge * 365.25 'that should be good enough.. it aint "right" but in my books its close enough!
Case Else 'the muppet of a user has supplied a duff index
CalcAge = -9999.9999 'treat 'em with the contempt they deserve
End Select
End Function```
untested air code, should get you close enough but user beware
Last edited by healdem; 04-30-09 at 06:22.

3. Registered User
Join Date
Feb 2009
Posts
19
TQ pro... . hope that i get it through.

4. Registered User
Join Date
Apr 2004
Location
Kingsland, Georgia
Posts
231
here's for years:
Code:
```' modified function from allenbrowne.com (http://allenbrowne.com/func-08.html)
Function Age(dtDOB As Date, Optional dtTemp As Date) As Integer
'Purpose:   Return the Age in years.
'Arguments: dtDOB = Date Of Birth, dtTemp = Date to calculate age on
'Return:    Whole number of years.

Dim dtBDay As Date  'Birthday in the year of calculation.

Age = 0          'Initialize to zero

If Date >= dtDOB Then      'Calculate only if the person has already been born
If dtTemp Then  'if they passed in another date, calculate age at that date
dtBDay = DateSerial(Year(dtTemp), Month(dtDOB), Day(dtDOB))
Age = DateDiff("yyyy", dtDOB, dtTemp) + (dtBDay > dtTemp)
Else
dtBDay = DateSerial(Year(Date), Month(dtDOB), Day(dtDOB))
Age = DateDiff("yyyy", dtDOB, Date) + (dtBDay > Date)
End If
End If
End Function```
Add in a couple datediff statements to get months and days

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•