Calculating YEARFRAC in Excel for dates spanning leap year

Question

If one uses Excel's YEARFRAC(date1,date2,1) function then Excel will use the basis as per the second parameter. This does not matter if date1 and date2 are in the same year, but it does matter if date1 is a leap year (e.g. 2020) and date2 is a non-leap year (e.g. 2021)

I think that a more accurate calculation will take into account that the basis of date1 can be different to the basis of date2.

For instance YEARFRAC(15/12/2020,15/01/2021,1) returns 0.08493151 But the real calculation is (31/12/2020-15/12/2020)/366 + (15/01/2020-31/12/2020)/365 = 0.084811737

I implemented the following in VBA. Does anyone have any fundamentally better way of doing it (either in Excel or in VBA)? (I am not looking for minor improvements to my rushed VBA code)

Call it using yearFracVBA("AA1","AA2")

Function yearFracVBA(aDate1, aDate2)
    result = 0
    y1 = Application.Evaluate("=YEAR(" & aDate1 & ")")
     y2 = Application.Evaluate("=YEAR(" & aDate2 & ")")
     
    For Y = y1 To y2
       fraction = 0
       If Y = y1 And Y = y2 Then fraction = Application.Evaluate("=YEARFRAC(" & aDate1 & "," & aDate2 & ",1)")
       If Y = y1 And Y < y2 Then fraction = Application.Evaluate("=YEARFRAC(" & aDate1 & ",DATE(YEAR(" & aDate1 & "),12,31),1)")
       If Y > y1 And Y < y2 Then fraction = 1
       If Y > y1 And Y = y2 Then fraction = Application.Evaluate("=YEARFRAC(DATE(YEAR(" & aDate2 & ")-1,12,31)," & aDate2 & ",1)")
       result = result + fraction
    Next Y
    yearFracVBA = result
End Function

Answer 1

The following code does not require Excel. It will work in any VBA Application:

Option Explicit

Public Function YearFracActual(ByVal aDate1 As Date, ByVal aDate2 As Date) As Double
    Dim lowerDate As Date
    Dim upperDate As Date
    Dim year1 As Integer
    Dim year2 As Integer
    
    'Get dates in order
    If aDate1 > aDate2 Then
        lowerDate = aDate2
        upperDate = aDate1
    Else
        lowerDate = aDate1
        upperDate = aDate2
    End If
    
    'Round down (floor) - exclude any time (hours, minutes, seconds)
    lowerDate = VBA.Int(lowerDate)
    upperDate = VBA.Int(upperDate)
    
    'Get years
    year1 = Year(lowerDate)
    year2 = Year(upperDate)
    
    If year1 = year2 Then
        YearFracActual = (upperDate - lowerDate) / GetDaysInYear(year1)
    Else
        Dim lowerFrac As Double
        Dim upperFrac As Double
        Dim midFrac As Double
    
        lowerFrac = (DateSerial(year1, 12, 31) - lowerDate) / GetDaysInYear(year1)
        midFrac = year2 - year1 - 1
        upperFrac = (upperDate - DateSerial(year2 - 1, 12, 31)) / GetDaysInYear(year2)
        
        YearFracActual = lowerFrac + midFrac + upperFrac
    End If
End Function

Private Function GetDaysInYear(ByVal year_ As Integer) As Integer
    If IsLeapYear(year_) Then
        GetDaysInYear = 366
    Else
        GetDaysInYear = 365
    End If
End Function

Private Function IsLeapYear(ByVal year_ As Integer) As Boolean
    If year_ Mod 400 = 0 Then
        IsLeapYear = True
    ElseIf year_ Mod 100 = 0 Then
        IsLeapYear = False
    Else
        IsLeapYear = (year_ Mod 4 = 0)
    End If
End Function