How to stop a date counting when an employee leaves the company

[Artois27]

I have an employee database with two date fields, one for Start Date with an unbound text box at the side of it that shows length of service and one for Birth Date which also has an unbound text box at the side of it that calculates how old they are in years and months.

The code I am using is as follows:
'*************************************************************
' 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

When an employee leaves, I would like the two dates to stop calculating but to show the correct length of time for length of service and age. In the database, there is another field called Leaving Date so it would be good if when the Leaving Date is completed, that it stops calculating the service and age.

 

[RuralGuy]

Change the functions to accept two dates instead of just one and hand it either Now or LeavingDate as the 2nd date.

(RG for short) aka Allan Bunch MS Access MVP acXP, ac07 - winXP Pro, Win7 Pro
Please respond to this forum so all may benefit

 

[TheAceMan1]

How are ya Artois27 . . .

[blue]RuralGuy[/blue] is right. Either you use the current date or leaving date as the end date. You just need to add the logic to your functions. Example:

[blue]Function Age(varBirthDate, [purple][b]LeaveDate[/b][/purple] As Variant) As Integer
   Dim varAge As Variant, [purple][b]EndDate[/b][/purple] As Variant

   If Not IsDate(varBirthDate) Then Exit Function
   [purple][b]EndDate[/b][/purple] = Date [green]'current date[/green]

   If IsDate([purple][b]LeaveDate[/b][/purple]) Then
      If Date > [purple][b]LeaveDate[/b][/purple] Then [purple][b]EndDate[/b][/purple] = [purple][b]LeaveDate[/b][/purple]
   End If
   
   varAge = DateDiff("yyyy", varBirthDate, EndDate)
   
   If Date < DateSerial(Year(EndDate), Month(varBirthDate), _
                        Day(varBirthDate)) Then
      varAge = varAge - 1
   End If
   
   Age = CInt(varAge)

End Function[/blue]

The function still calculates but you'll always get the same results once the current date >= the leave date.

[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[RuralGuy]

Nice touch AceMan.

(RG for short) aka Allan Bunch MS Access MVP acXP, ac07 - winXP Pro, Win7 Pro
Please respond to this forum so all may benefit