Years/Months

AN60

Registered User.
Local time
Today, 16:46
Joined
Oct 25, 2003
Messages
283
I calculate the number of days between two dates and now I want to figure months and years. Any suggestions?
 
Neileg
Thanks for your reply.
I have probably solved my problem using a simple =Date()-min([date]) then dividing by 7(to give weeks) & so on.
 
As Neil pointed out, DateDiff() is the way to go. It becomes a little more complex when returning more than one measurement (e.g. years & months).

The following code will return age as yy.mm.dd. You can modify it to meet your criteria.
Code:
Function AgeCount5(varDOB As Variant, varDate As Variant) As String

' PURPOSE:  Determines the difference between two dates in years,
'           months and days.
'
' 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)
'
' CODED BY: raskew
'
' NOTES:    To test:  Type '? agecount5("03/04/83", "03/23/00")
'                     in the debug window. The function will
'                     return "17.0.19".

Dim dteDOB      As Date
Dim dteDate     As Date
Dim dteHold     As Date
Dim intYears    As Integer
Dim intMonths   As Integer
Dim intDays     As Integer

On Error GoTo Err_AgeCount5

If IsDate(varDOB) And IsDate(varDate) Then
   
   dteDOB = DateValue(varDOB)
   dteDate = DateValue(varDate)
   
  'Reverse the dates if they were input backwards
   If dteDOB > dteDate Then
      dteHold = dteDOB
      dteDOB = dteDate
      dteDate = dteHold
   End If

   intYears = DateDiff("yyyy", dteDOB, dteDate) + (dteDate < _
              DateSerial(Year(dteDate), Month(dteDOB), Day(dteDOB)))
   dteDOB = DateAdd("yyyy", intYears, dteDOB)
   
   intMonths = DateDiff("m", dteDOB, dteDate) + (Day(dteDOB) > Day(dteDate))
   dteDOB = DateAdd("m", intMonths, dteDOB)
   
   intDays = DateDiff("d", dteDOB, dteDate)

   AgeCount5 = LTrim(Str(intYears)) & "." & LTrim(Str(intMonths)) & "." & LTrim(Str(Int(intDays)))

Else
   
   MsgBox "Invalid date parameters -- please try again", vbOKOnly, "Check input dates!"
   GoTo Exit_AgeCount5

End If

Exit_AgeCount5:
    Exit Function

Err_AgeCount5:
    Select Case Err.Number
    Case 0
        Resume Next
    Case Else
        MsgBox Err.Number & ": " & Err.Description
    End Select
    Resume Exit_AgeCount5

End Function
HTH - Bob
 

Users who are viewing this thread

Back
Top Bottom