The following can easily be modified to do what you want:

' a Macro to calculate the age in years, months and days

' based on a birthdate entered in cell A2 and insert the

' age in cell A3

' Macro created 16/9/00 by Doug Robbins

'

Dim Years As Long

Dim Months As Long

Dim Days As Long

Dim Birthrange As Range

Dim Birthday As Long

Dim Day As Long

Dim Age As String

Dim Agedays As String

Dim Yearnow As Long

Dim Monthnow As Long

Monthnow = Val(Format(Date, "m"))

Yearnow = Val(Format(Date, "yyyy"))

Dim mon$(12)

   mon$(1) = "January": mon$(2) = "February": mon$(3) = "March": mon$(4) =
"April": mon$(5) = "May": mon$(6) = "June": mon$(7) = "July": mon$(8) =
"August": mon$(9) = "September": mon$(10) = "October": mon$(11) =
"November": mon$(12) = "December"

Dim monthdays$(12)

   If ((Yearnow Mod 4 = 0 And Calyear Mod 400 = 0) Or (Calyear Mod 4 = 0
And Calyear Mod 100 <> 0)) Then

       monthdays$(1) = "31": monthdays$(2) = "29": monthdays$(3) = "31":
monthdays$(4) = "30": monthdays$(5) = "31": monthdays$(6) = "30":
monthdays$(7) = "31": monthdays$(8) = "31": monthdays$(9) = "30":
monthdays$(10) = "31": monthdays$(11) = "30": monthdays$(12) = "31"

   Else

       monthdays$(1) = "31": monthdays$(2) = "28": monthdays$(3) = "31":
monthdays$(4) = "30": monthdays$(5) = "31": monthdays$(6) = "30":
monthdays$(7) = "31": monthdays$(8) = "31": monthdays$(9) = "30":
monthdays$(10) = "31": monthdays$(11) = "30": monthdays$(12) = "31"

   End If

Set Birthrange = ActiveDocument.Tables(1).Cell(1, 2).Range

Birthrange.End = Birthrange.End - 1

Birthdate = Birthrange

Years = DateDiff("yyyy", Birthdate, Date)

Months = DateDiff("m", Birthdate, Date) - Years * 12

Birthday = Format(Birthdate, "d")

Day = Format(Date, "d")

Days = Day - Birthday

If Days > 0 Then

   Agedays = " and " & Format(Days) & " days."

ElseIf Days < 0 Then

   Agedays = " and " & Format(monthdays$(Monthnow) - Birthday + Day) & "
days."

   Months = Months - 1

Else

   Agedays = "."

End If

Age = Format(Years) & " years, " & Format(Months) & " Months" & Agedays

ActiveDocument.Tables(1).Cell(1, 3).Range.Text = Age

Hi
A little more than DateDiff() is needed for this problem.

For instance: DateDiff("yyyy", #12/30/2005#, #1/1/2006#) will return 1 for a
person 2 days old.

Here is a function that will do the job.

==============================================================
Option Explicit
Const TARGETAGE As Long = 14

Private Function GetAge(dBirthDate As Date) As Boolean
Dim BirthYear As Long
Dim CurrentYear As Long
Dim BirthMonth As Long
Dim CurrentMonth As Long
Dim BirthDay As Long
Dim CurrentDay As Long

BirthYear = Year(dBirthDate)
CurrentYear = Year(Date)
BirthMonth = Month(dBirthDate)
CurrentMonth = Month(Date)
BirthDay = Day(dBirthDate)
CurrentDay = Day(Date)

If CurrentYear - BirthYear > TARGETAGE Then ' must be older than the
TARGETAGE
   GetAge = True

ElseIf CurrentYear - BirthYear < TARGETAGE Then ' must be younger the
TARGETAGE
   GetAge = False

' if we get here the difference is equal to the TARGETAGE - check the month
ElseIf CurrentMonth - BirthMonth > 0 Then ' birth month is before current
month
   GetAge = True

ElseIf CurrentMonth - BirthMonth < 0 Then 'birth month is after current
month
   GetAge = False

' if we get here the CurrentMonth is the same as the BirthMonth
ElseIf CurrentDay - BirthDay >= 0 Then
   GetAge = True

Else
   GetAge = False

End If

End Function
=========================================================================

Good luck
Harold