Date functions are a pain, months and years don't have a standard length and do we want to include both beginning and end dates when figuring out time periods? the further you go into the details of date ranges the more knotty the calculations become. That said a few well placed vba functions can help - to that end here's a bunch to get you started and can be tweaked for a number of purposes:
' wraps the DateDiff function for use on a worksheet Public Function GetDateDiff(ByVal DuratType As String, ByVal StartDate As Date, ByVal EndDate As Date _ , Optional FirstDayOfWeek As VbDayOfWeek = vbSunday _ , Optional FirstWeekOfYear As VbFirstWeekOfYear = vbFirstJan1) As Integer GetDateDiff = DateDiff(DuratType, StartDate, EndDate, FirstDayOfWeek, FirstWeekOfYear) End Function ' wraps the DateAdd function for use on a worksheet Public Function GetDateAdd(interval As String, initialDate As Date, Value As Double) As Date GetDateAdd = DateAdd(interval, Value, initialDate) End Function ' Gives a specific function to enable a period presented as a year decimal to be added to a date Public Function DateAddYrDec(initial As Date, yeardecimal As Double) As Date DateAddYrDec = DateAdd("M", yeardecimal * 12, initial) End Function ' Returns a decimal to represent a time period based on years and days/365 Public Function GetYrsDaysDecimal(ByVal StartDate As Date, ByVal EndDate As Date, _ Optional RoundTo As Integer = 4) As Double Dim Yrs As Integer Dim Days As Integer Yrs = GetCompleteYears(StartDate, EndDate) Days = DateDiff("d", DateAdd("yyyy", Yrs, StartDate), EndDate) - 1 Dim out As Double out = Yrs + (Days / 365) GetYrsDaysDecimal = Round(out, RoundTo) End Function ' Returns a year decimal based on complete years and months between two dates Public Function GetYrsMthDecimal(ByVal StartDate As Date, ByVal EndDate As Date, _ Optional RoundTo As Integer = 4, Optional Absolute As Boolean = False) As Double Dim res As Double res = Round((GetCompleteMonths(StartDate, EndDate)) / 12 _ , RoundTo) If Absolute And EndDate <= StartDate Then res = res * -1 GetYrsMthDecimal = res End Function ' Returns a year decimal based on the years, months and month percentage between two dates Public Function GetYrsMthPercDecimal(ByVal StartDate As Date, ByVal EndDate As Date, _ Optional RoundTo As Integer = 4) As Double Dim res As Double res = Round((DateDiff("M", StartDate, EndDate) + MonthDiffDec(StartDate, EndDate)) / 12 _ , RoundTo) If EndDate <= StartDate Then res = res * -1 GetYrsMthPercDecimal = res End Function ' Returns a year decimal based on the actual time between two dates Public Function GetAccYrDecimal(ByVal StartDate As Date, ByVal EndDate As Date, _ Optional RoundTo As Integer = 4) As Double Dim res As Double res = Round((DateDiff("M", StartDate, EndDate) + MonthDiffDec(StartDate, EndDate)) / 12 _ , RoundTo) If EndDate <= StartDate Then res = res * -1 GetAccYrDecimal = res End Function ' Returns a number representing the percentage of month between two given dates, ignoring years Public Function MonthDiffDec(varDateFrom As Variant, Optional varDateTo As Variant) As Variant Dim intMonths As Integer Dim IntDays As Integer If Not IsNull(varDateFrom) Then If IsMissing(varDateTo) Then varDateTo = VBA.Date intMonths = DateDiff("m", varDateFrom, varDateTo) - (GetAge(varDateFrom, varDateTo) * 12) If Day(varDateFrom) > Day(varDateTo) Then intMonths = intMonths - 1 IntDays = varDateTo - DateSerial(Year(varDateTo), Month(varDateTo) - 1, Day(varDateFrom)) Else IntDays = varDateTo - DateSerial(Year(varDateTo), Month(varDateTo), Day(varDateFrom)) End If MonthDiffDec = intMonths + IntDays / Day(DateSerial(Year(varDateTo), Month(varDateTo) + 1, 0)) End If End Function ' Returns an integer of complete years for the passed dates Public Function GetAge(varDoB As Variant, Optional varAgeAt As Variant) As Integer If IsMissing(varAgeAt) Then varAgeAt = VBA.Date GetAge = DateDiff("yyyy", varDoB, varAgeAt) - _ IIf(Format(varAgeAt, "mmdd") < Format(varDoB, "mmdd"), 1, 0) End Function ' returns the month end for the date given Public Function GetMonthEnd(PassDate As Date) As Date Dim carry As Date carry = DateSerial(Year(PassDate), Month(PassDate), 1) carry = DateAdd("M", 1, carry) carry = DateAdd("D", -1, carry) GetMonthEnd = carry End Function ' returns complete months from DateDiff, correcting for whole months rather than using month separators (counting the first) Public Function GetCompleteMonths(StartDate As Date, EndDate As Date) As Integer Dim Mths As Integer Mths = DateDiff("m", StartDate, EndDate) If Day(StartDate) > Day(EndDate) Then Mths = Mths - 1 GetCompleteMonths = Mths End Function ' returns the number of whole years between two dates Public Function GetCompleteYears(StartDate As Date, EndDate As Date) As Integer If StartDate >= EndDate Then GetCompleteYears = 0 Exit Function End If Dim FullYrs, YrDiff As Integer ' get the number of years difference YrDiff = DatePart("yyyy", EndDate) - DatePart("yyyy", StartDate) If DatePart("m", StartDate) < DatePart("m", EndDate) Or _ (DatePart("m", StartDate) = DatePart("m", EndDate) And DatePart("d", StartDate) <= DatePart("d", EndDate)) Then ' if the start date was before or equal to the end date in months and days ' full years is fine FullYrs = YrDiff Else ' otherwise we're cutting, minus one FullYrs = YrDiff - 1 End If GetCompleteYears = FullYrs End Function ' Returns the number of complete tax years between two dates Public Function GetCompleteTaxYears(StartDate As Date, EndDate As Date) As Integer If StartDate >= EndDate Then GetCompleteTaxYears = 0 Exit Function End If Dim TaxYrs As Integer ' get the number of years difference TaxYrs = DatePart("yyyy", EndDate) - DatePart("yyyy", StartDate) If DatePart("m", StartDate) > 4 Or _ (DatePart("m", StartDate) = 4 And DatePart("d", StartDate) > 6) Then ' we started after the start of the tax year, take one off TaxYrs = TaxYrs - 1 End If If DatePart("m", EndDate) < 4 Or _ (DatePart("m", EndDate) = 4 And DatePart("d", EndDate) < 5) Then ' we ended before the end of the tax year, take one off TaxYrs = TaxYrs - 1 End If GetCompleteTaxYears = TaxYrs End Function ' Returns the number of occurences of a day/month between two dates Public Function GetDateOccurrences(Day As Integer, Month As Integer, StartDate As Date, EndDate As Date, _ Optional inclusiveStart As Boolean = True, Optional inclusiveEnd As Boolean = True) As Integer If StartDate > EndDate Then GetDateOccurrences = 0 Exit Function ElseIf StartDate = EndDate And (inclusiveStart Or inclusiveEnd) Then GetDateOccurrences = 1 Exit Function End If Dim AnnivYrs, YrDiff As Integer ' get the number of years difference YrDiff = DatePart("yyyy", EndDate) - DatePart("yyyy", StartDate) Dim startBefore, endAfter As Boolean If inclusiveStart Then startBefore = DatePart("m", StartDate) < Month Or _ (DatePart("m", StartDate) = Month And DatePart("d", StartDate) <= Day) Else startBefore = DatePart("m", StartDate) < Month Or _ (DatePart("m", StartDate) = Month And DatePart("d", StartDate) < Day) End If If inclusiveEnd Then endAfter = DatePart("m", EndDate) > Month Or _ (DatePart("m", EndDate) = Month And DatePart("d", EndDate) >= Day) Else endAfter = DatePart("m", EndDate) > Month Or _ (DatePart("m", EndDate) = Month And DatePart("d", EndDate) > Day) End If If startBefore <> endAfter Then AnnivYrs = YrDiff ElseIf startBefore Then AnnivYrs = YrDiff + 1 Else AnnivYrs = YrDiff - 1 End If GetDateOccurrences = AnnivYrs End Function ' Returns a list of date occurences between two dates (not for worksheet use) Public Function GetDateOccurrencesList(Day As Integer, Month As Integer, StartDate As Date, EndDate As Date, _ Optional inclusiveStart As Boolean = True, Optional inclusiveEnd As Boolean = True) As Date() Dim NoOccurrences As Integer Dim startBefore As Boolean Dim StartYr As Integer Dim emptyArr() As Date NoOccurrences = GetDateOccurrences(Day, Month, StartDate, EndDate, inclusiveStart, inclusiveEnd) If NoOccurrences = 0 Then GetDateOccurrencesList = emptyArr Exit Function End If Dim DateArr() As Date If StartDate > EndDate Then ' passing back the empty array GetDateOccurrencesList = DateArr Exit Function ElseIf StartDate = EndDate And (inclusiveStart Or inclusiveEnd) Then ReDim DateArr(0) DateAdd(0) = StartDate GetDateOccurrencesList = DateArr Exit Function End If ReDim DateArr(NoOccurrences - 1) If inclusiveStart Then startBefore = DatePart("m", StartDate) < Month Or _ (DatePart("m", StartDate) = Month And DatePart("d", StartDate) <= Day) Else startBefore = DatePart("m", StartDate) < Month Or _ (DatePart("m", StartDate) = Month And DatePart("d", StartDate) < Day) End If If startBefore Then StartYr = Year(StartDate) Else StartYr = Year(StartDate) + 1 End If Dim i As Integer For i = 0 To UBound(DateArr) DateArr(i) = DateSerial(StartYr, Month, Day) StartYr = StartYr + 1 Next i GetDateOccurrencesList = DateArr End Function ' Returns the date of the preceeding 6th of april from the passed date Public Function GetPreceeding64(TestDate As Date) As Date If Month(TestDate) < 4 Or _ (Month(TestDate) = 4 And Day(TestDate) < 6) Then GetPreceeding64 = DateSerial(Year(TestDate) - 1, 4, 6) Else GetPreceeding64 = DateSerial(Year(TestDate), 4, 6) End If End Function ' Returns the date of the preceeding passed anniversary for the passed date Public Function GetPreceedingAnniversary(pDay As Integer, pMonth As Integer, TestDate As Date) As Date If pMonth = 2 And pDay = 29 Then ' we're looking for a leap year Dim YearDiv As Double Dim WholeYearDiv As Integer YearDiv = Year(TestDate) / 4 WholeYearDiv = Year(TestDate) \ 4 If Month(TestDate) < pMonth Or _ (Month(TestDate) = pMonth And Day(TestDate) <= pDay) Then ' Earlier than/on anniv, looking for preceeding leap year If YearDiv = WholeYearDiv Then ' We're in a leap year, get the one before it! GetPreceedingAnniversary = DateSerial((YearDiv - 1) * 4, pMonth, pDay) Else ' this isn't a leap year, get 4 * YearDiv GetPreceedingAnniversary = DateSerial(YearDiv * 4, pMonth, pDay) End If Else ' passed anniv in this year, is this a leap year? If YearDiv = WholeYearDiv Then ' We're in a leap year, get this one! GetPreceedingAnniversary = DateSerial(Year(TestDate), pMonth, pDay) Else ' this isn't a leap year, get the one before it (get 4 * YearDiv) GetPreceedingAnniversary = DateSerial(YearDiv * 4, pMonth, pDay) End If End If ElseIf Month(TestDate) < pMonth Or _ (Month(TestDate) = pMonth And Day(TestDate) <= pDay) Then ' less than or = to anniversary, get last year GetPreceedingAnniversary = DateSerial(Year(TestDate) - 1, pMonth, pDay) Else ' Have passed the anniversary this year, get this year GetPreceedingAnniversary = DateSerial(Year(TestDate), pMonth, pDay) End If End Function