VBA code to generate accurate elapsed number of months & days between two dates-CodePudding

I am trying to develop VBA code that yields the accurate number of months and remaining days between two dates.

The test dates to be used are the following:

Date1: 04/19/1995

Date2: 12/26/22

The correct answer per: https://www.calculator.net/date-calculator.html is: 332 months 7 days

The correct answer generated per my VBA code below is: 332 months 3 days.

Can anyone shed some light as to why this is the case?

Private Sub CommandButton7_Click()


' Calculate the difference between two dates in months and remaining days

Dim startDate As Date
Dim endDate As Date
Dim months As Long
Dim days As Long

startDate = Application.InputBox("Enter a date:", "Date Input 1", Date, Type:=2)
endDate = Application.InputBox("Enter another date:", "Date Input 2", Date, Type:=2)

months = Abs(DateDiff("m", startDate, endDate))
days = Abs(DateDiff("d", startDate, endDate)) Mod 30

MsgBox "The difference between the two dates is: " & months & " months and " & days & " days."

End Sub

CodePudding user response：

Yes. The following line in your code -

days = Abs(DateDiff("d", startDate, endDate)) Mod 30

assumes that all months have 30 days. They do not!

CodePudding user response：

It is not that simple because of the varying count of days of the months. You have to use DateAdd to obtain the correct month count.

This function does it right:

' Returns the difference in full months from DateOfBirth to current date,
' optionally to another date.
' Returns by reference the difference in days.
' Returns zero if AnotherDate is earlier than DateOfBirth.
'
' Calculates correctly for:
'   leap Months
'   dates of 29. February
'   date/time values with embedded time values
'   any date/time value of data type Date
'
' DateAdd() is, when adding a count of months to dates of 31th (29th),
' used for check for month end as it correctly returns the 30th (28th)
' when the resulting month has 30 or less days.
'
' 2015-11-24. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function AgeMonthsDays( _
    ByVal DateOfBirth As Date, _
    Optional ByVal AnotherDate As Variant, _
    Optional ByRef Days As Integer) _
    As Long
    
    Dim ThisDate    As Date
    Dim Months      As Long
      
    If IsDateExt(AnotherDate) Then
        ThisDate = CDate(AnotherDate)
    Else
        ThisDate = Date
    End If
    
    ' Find difference in calendar Months.
    Months = DateDiff("m", DateOfBirth, ThisDate)
    If Months < 0 Then
        Months = 0
    Else
        If Months > 0 Then
            ' Decrease by 1 if current date is earlier than birthday of current year
            ' using DateDiff to ignore a time portion of DateOfBirth.
            If DateDiff("d", ThisDate, DateAdd("m", Months, DateOfBirth)) > 0 Then
                Months = Months - 1
            End If
        End If
        ' Find difference in days.
        Days = DateDiff("d", DateAdd("m", Months, DateOfBirth), ThisDate)
    End If
        
    AgeMonthsDays = Months
  
End Function

Example (in the immidiate pane):

Days% = 0
? AgeMonthsDays(#04/19/1995#, #12/26/2022#, Days%), Days%
 332           7

It is from my library at GitHub: VBA.Date.