Calculate age and length of service

[Rose412]

Hi everyone.

I have a table [tblEmployee] from which I need to calculate the employees' ages and lengths of service from the fields [DateOfBirth] and [DateJoined].


For the Age Calculation
I have successfully used an expression that I found in these forums (see the query in the attached Access 2k database):

Age: DateDiff("yyyy",[DateOfBirth],Date())+Int(Format(Date(),"mmdd")<Format([DateOfBirth],"mmdd"))

It correctly returns the employees' ages as at the current system date.

But I would like to make it more flexible. I want to convert it into a public function so that it can calculate the age as at a specified date. And if the date is not specified, then calculate the age as at the current system date. Can it be done?


For the Calculation of Length of Service
Similar to the age calculation, I would like to have a public function that can return the length of service as at a specified date, or at the current system date if the date is not specified.

To show what I need, I have manually entered in the table the Lengths of Service as at Dec 1 2003. They are based on the calendar dates, so that, for an employee whose [DateJoined] is Dec 1 2002, the length of service as at Dec 1 2003 would be "1 Yr 0 mon 1 day".


I should appreciate any help.

Thanks in advance.

Rose

 

[Mile-O]

Public Function Age(ByVal dteStart As Date, Optional dteTarget As Date) As Integer

    If dteTarget = 0 Then
        Age = DateDiff("yyyy", dteStart, Date) + Int(Format(Date, "mmdd") < Format(dteStart, "mmdd"))
    Else
        Age = DateDiff("yyyy", dteStart, dteTarget) + Int(Format(dteTarget, "mmdd") < Format(dteStart, "mmdd"))
    End If

End Function

 

[raskew]

Here's a little different approach, which will result in years.months.days. This emulates the manual method the US military used for years to determine an individual's eligibility for promotion, retirement pay, etc.

Function AgeCount(varDOB As Variant, Optional varDate As Variant) As String
'*******************************************
' PURPOSE: Determines the difference between two dates.
'
' ARGUMENTS:  (will accept either dates (e.g., #03/24/00#) or
'              strings (e.g., "03/24/00")

'  varDOB:  The earlier of two dates.
'  varDate: The later of two dates.
'
' RETURNS:  A string as years.months.days, e.g., (17.6.21)

' NOTES: To test:  Type ? agecount("03/04/83", "03/23/00")
'                  in the debug window. The function will
'                  return "17.0.19".
'                  Type ? agecount("03/04/83") in the debug
'                  window and the function substitutes the
'                  system date for varDate and returns
'                  (as of 12/1/03) "20.8.27"
'*******************************************

Dim dteDOB As Date, dteDate As Date
Dim intOldYears As Integer, intNuYears As Integer
Dim intOldMonths As Integer, intNuMonths As Integer
Dim intOldDays As Integer, intNuDays As Integer
Dim intyears As Integer, intmonths As Integer, intdays As Integer
Dim AgeHold As String

'use system date if varDate not supplied
varDate = IIf(IsMissing(varDate), Date, varDate)
dteDOB = DateValue(varDOB)
dteDate = DateValue(varDate)

intOldYears = year(dteDOB)
intOldMonths = Month(dteDOB)
intOldDays = Day(dteDOB)
intNuYears = year(dteDate)
intNuMonths = Month(dteDate)
intNuDays = Day(dteDate)

If intNuDays < intOldDays Then
   intNuDays = intNuDays + 30
   intNuMonths = intNuMonths - 1
End If

If intNuMonths < intOldMonths Then
   intNuMonths = intNuMonths + 12
   intNuYears = intNuYears - 1
End If

intyears = intNuYears - intOldYears
intmonths = intNuMonths - intOldMonths
intdays = intNuDays - intOldDays
AgeHold = LTrim(str(intyears)) & "." & LTrim(str(intmonths)) & "." & LTrim(str(intdays))
AgeCount = AgeHold

End Function

HTH - Bob

 

[Rose412]

Thank you so much. The functions work perfectly.

Rose