Age = Abs(datediff("yyyy",Date2,Date1))
Age = Abs(datediff("yyyy",Date2,Date1))
Public Function CalculateAge(DOB As Date) As Integer
Dim WorkDate As Date
Dim RawAge As Integer
RawAge = DateDiff("yyyy", DOB, Date)
WorkDate = DateSerial(Year(Date), month(DOB), Day(DOB))
CalculateAge = RawAge + (Date < WorkDate) '(Date < WorkDate) = 0 or -1
End Function
Function CalculateLongAge(DOB As Date, CurDate As Date) As String
Dim Y As Integer
Dim M As Integer
Dim D As Integer
Dim Temp1 As Date
Temp1 = DateSerial(Year(CurDate), month(DOB), Day(DOB))
Y = Year(CurDate) - Year(DOB) + (Temp1 > CurDate)
M = month(CurDate) - month(DOB) - (12 * (Temp1 > CurDate))
D = Day(CurDate) - Day(DOB)
If D < 0 Then
M = M - 1
D = Day(DateSerial(Year(CurDate), month(CurDate) + 1, 0)) + D + 1
End If
CalculateLongAge = Y & " years " & M & " months " & D & " days"
End Function
Public Function CalculateAge(DOB As Date, DOP As Date) As Integer
Dim WorkDate As Date
Dim RawAge As Integer
RawAge = DateDiff("yyyy", DOB, DOP)
WorkDate = DateSerial(Year(DOP), month(DOB), Day(DOB))
CalculateAge = RawAge + (DOP< WorkDate) '(Date < WorkDate) = 0 or -1
End Function
So to use the first function.Age = CalculateAge(DOB, DOP)
Public Function Years( _
ByVal datDate1 As Date, _
ByVal datDate2 As Date, _
Optional ByVal booLinear As Boolean) _
As Integer
' Returns the difference in full years between datDate1 and datDate2.
'
' Calculates correctly for:
' negative differences
' leap years
' dates of 29. February
' date/time values with embedded time values
' negative date/time values (prior to 1899-12-29)
'
' Optionally returns negative counts rounded down to provide a
' linear sequence of year counts.
' For a given datDate1, if datDate2 is decreased step wise one year from
' returning a positive count to returning a negative count, one or two
' occurrences of count zero will be returned.
' If booLinear is False, the sequence will be:
' 3, 2, 1, 0, 0, -1, -2
' If booLinear is True, the sequence will be:
' 3, 2, 1, 0, -1, -2, -3
'
' If booLinear is False, reversing datDate1 and datDate2 will return
' results of same absolute Value, only the sign will change.
' This behaviour mimics that of Fix().
' If booLinear is True, reversing datDate1 and datDate2 will return
' results where the negative count is offset by -1.
' This behaviour mimics that of Int().
' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of years to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2000-11-03. Cactus Data ApS, CPH.
' 2000-12-16. Leap year correction modified to be symmetrical.
' Calculation of intDaysDiff simplified.
' Renamed from YearsDiff() to Years().
' 2000-12-18. Introduced cbytMonthDaysMax.
' 2007-06-22. Version 2. Complete rewrite.
' Check for month end of February performed with DateAdd()
' after idea of Markus G. Fischer.
Dim intDiff As Integer
Dim intSign As Integer
Dim intYears As Integer
' Find difference in calendar years.
intYears = DateDiff("yyyy", datDate1, datDate2)
' For positive resp. negative intervals, check if the second date
' falls before, on, or after the crossing date for a full 12 months period
' while at the same time correcting for February 29. of leap years.
If DateDiff("d", datDate1, datDate2) > 0 Then
intSign = Sgn(DateDiff("d", DateAdd("yyyy", intYears, datDate1), datDate2))
intDiff = Abs(intSign < 0)
Else
intSign = Sgn(DateDiff("d", DateAdd("yyyy", -intYears, datDate2), datDate1))
If intSign <> 0 Then
' Offset negative count of years to continuous sequence if requested.
intDiff = Abs(booLinear)
End If
intDiff = intDiff - Abs(intSign < 0)
End If
' Return count of years as count of full 12 months periods.
Years = intYears - intDiff
End Function
/gustavTitle | # Comments | Views | Activity |
---|---|---|---|
Open Process in Access 2013 will not open form | 8 | 38 | |
Display multiple images in report | 12 | 82 | |
Display updated table through a subform | 4 | 17 | |
Exiting a Form/Subform does not work correctly | 9 | 15 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
14 Experts available now in Live!