Option Explicit
'Some VBA Tips
'Avoid traffic to and from the worksheet: that's why array functions are faster
'Keep the number of Variants under control, they are reputedly slower
'Note: Date Arithmetic that accurately calculates ACT/ACT (in period) daycount in all cases is beyond the scope of
'      this VBA code.
'
 Option Base 1
 'Options
 Const c_Internal = 1024
 Const c_CorActActinPeriod = 256
 Const pi = 3.1415926
Function NextDate(MyDate, Periods As Range) As Date
    Dim LastDate As Date, np As Integer, lp As Integer
    PeriodsLastNext MyDate, Periods, NextDate, LastDate, np, lp
End Function
Function LastDate(MyDate, Periods As Range) As Date
    Dim NextDate As Date, np As Integer, lp As Integer
    PeriodsLastNext MyDate, Periods, NextDate, LastDate, np, lp
End Function
Function PeriodsLastNext(MyDate, Periods, ByRef NextDate As Date, ByRef LastDate As Date, ByRef NextPerN As Integer, ByRef LastPerN As Integer)
    Dim n%, maxn%, p(), pd() As Integer, pm() As Integer, md As Integer, mm As Integer, np As Integer, lp As Integer
    maxn = Dim_Date(Periods)
    md = Day(MyDate)
    mm = Month(MyDate)
    ReDim pd(1 To maxn)
    ReDim pm(1 To maxn)
    For n = 1 To maxn
        pd(n) = Day(Periods.Cells(n))
        pm(n) = Month(Periods.Cells(n))
    Next n
    For n = 1 To maxn
        If n = 1 Then
            If mm < pm(n) Or (mm = pm(n) And md < pd(n)) Then
                np = n
                lp = maxn
                Exit For
           End If
        Else
           If (mm > pm(n - 1) Or (mm = pm(n - 1) And md >= pd(n - 1))) And (mm < pm(n) Or (mm = pm(n) And md < pd(n))) Then
                np = n
                lp = n - 1
                Exit For
           End If
        End If
    Next n
    NextDate = DateSerial(Year(MyDate), pm(np), pd(np))
    If NextDate < MyDate Then NextDate = DateSerial(Year(MyDate) + 1, pm(np), pd(np))
    LastDate = DateSerial(Year(MyDate), pm(lp), pd(lp))
    If LastDate >= MyDate Then LastDate = DateSerial(Year(MyDate) - 1, pm(lp), pd(lp))
    LastPerN = Year(LastDate) * maxn + lp
    NextPerN = LastPerN + 1
End Function
Private Function Internalise(Options)
    If Not OptionPresent(c_Internal, Options) Then
        Internalise = Options + c_Internal
    Else
        Internalise = Options
    End If
End Function
Private Function OptionPresent(OptionSought%, Options) As Boolean
    Dim n%, c%
    c = Options
    n = 1024
    Do While n >= 1
        If c >= n Then
            If n = OptionSought Then
                OptionPresent = True
                Exit Function
            End If
            c = c - n
        End If
        n = n / 2
    Loop
    OptionPresent = False
End Function
Private Function DaysInYear(dt)
    Dim y%
    y = Year(dt)
    DaysInYear = DateSerial(y + 1, 1, 1) - DateSerial(y, 1, 1)
End Function
Private Function DaysInMonth(dt)
    Dim y%, m%
    DaysInMonth = DateSerial(y, m + 1, 1) - DateSerial(y, m, 1)
End Function
Function PartialPeriod(StartPeriod, EndPeriod, TheDate, PmtsPerYear, DayCount, Start)
    'Returns: A fraction of a period.
    'Note:The period is defined by StartPeriod and EndPeriod, or PmtsPerYear.  They must be consistent.
    Dim PeriodLength, d1%, d2%, m1%, m2%, y1%, y2%, lastday1 As Boolean
    Dim yeardays#, temp, t%, sublen1%, sublen2%, diy1%, diy2%, dim1%, dim2%
    If Start Then
        PeriodLength = TheDate - StartPeriod
    Else
        PeriodLength = EndPeriod - TheDate
    End If
    If DayCount < 2 Or DayCount = 4 Or DayCount = 5 Then
        If Start Then
            d1 = Day(StartPeriod)
            m1 = Month(StartPeriod)
            y1 = Year(StartPeriod)
            d2 = Day(TheDate)
            m2 = Month(TheDate)
            y2 = Year(TheDate)
            temp = DateSerial(y2, 1, 1)
            sublen1 = temp - StartPeriod
            sublen2 = TheDate - temp
            diy1 = DaysInYear(StartPeriod)
            diy2 = DaysInYear(TheDate)
            dim1 = DaysInMonth(StartPeriod)
            dim2 = DaysInMonth(TheDate)
            If Month(StartPeriod) <> Month(StartPeriod + 1) Then
                lastday1 = True
            Else
                lastday1 = False
            End If
        Else
            d1 = Day(TheDate)
            m1 = Month(TheDate)
            y1 = Year(TheDate)
            d2 = Day(EndPeriod)
            m2 = Month(EndPeriod)
            y2 = Year(EndPeriod)
            temp = DateSerial(y2, 1, 1)
            sublen1 = temp - TheDate
            sublen2 = EndPeriod - temp
            diy1 = DaysInYear(TheDate)
            diy2 = DaysInYear(EndPeriod)
            dim1 = DaysInMonth(TheDate)
            dim2 = DaysInMonth(EndPeriod)
            If Month(TheDate) <> Month(TheDate + 1) Then
                lastday1 = True
            Else
                lastday1 = False
            End If
        End If
    End If
    Select Case (DayCount)
        Case 0: '30/360 PSA
                If m1 = 2 And lastday1 Then d1 = 30
                If d1 = 31 Then d1 = 30
                If d2 = 31 And d1 = 30 Then d2 = 30
                PartialPeriod = ((y2 - y1) * 360 + (m2 - m1) * 30 + d2 - d1) / 360 * PmtsPerYear
        Case 1: 'ACT/ACT
                PartialPeriod = (sublen1 / diy1 + sublen2 / diy2) * PmtsPerYear
        Case 2: 'ACT/360
                PartialPeriod = PeriodLength / 360 * PmtsPerYear
        Case 3: 'ACT/365
                PartialPeriod = PeriodLength / 365 * PmtsPerYear
        Case 4: '30E/360
                If d1 > 30 Then d1 = 30
                If d2 > 30 Then d2 = 30
                PartialPeriod = ((y2 - y1) * 360 + (m2 - m1) * 30 + d2 - d1) / 360 * PmtsPerYear
        Case 5: 'ACTM/12 (Decimal Year)
                PartialPeriod = ((y2 - y1) + (m2 - m1 - 1 + (d2 - 1) / dim2 + (dim1 - d1 + 1) / dim1) / 12) * PmtsPerYear
        Case 6: 'ACT/ACT (in period)
                PartialPeriod = PeriodLength / (EndPeriod - StartPeriod)
    End Select
    If PartialPeriod < 0 Then PartialPeriod = 0
End Function
Function a_RentMkt(PmtDates, RentStartDate, FirstReview, ExpOrBrk, MktRent, InitialRent, _
GrowthDates, GrowthRates, RevMos, DayCount, Options)
    Dim Rents(), IntOptions, maxt%, t%, CurrentRent, NextReview, tpstart, tpend, PmtsPerYear
    IntOptions = Internalise(Options)
    maxt = Dim_Date(PmtDates)
    ReDim Rents(1 To maxt)
    PmtsPerYear = PaymentsPerYear(PmtDates)
    CurrentRent = InitialRent / PmtsPerYear
    NextReview = FirstReview

    For t = 1 To maxt
        Rents(t) = 0
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpend <= RentStartDate Then GoTo nextt
        If tpstart >= ExpOrBrk Then GoTo nextt
        If Happens(RentStartDate, tpstart, tpend) Then
            Rents(t) = CurrentRent * PartialPeriod(tpstart, tpend, RentStartDate, PmtsPerYear, DayCount, False)
        ElseIf Happens(ExpOrBrk, tpstart, tpend) Then
            Rents(t) = CurrentRent * PartialPeriod(tpstart, tpend, ExpOrBrk, PmtsPerYear, DayCount, True)
        ElseIf (tpend < NextReview) Then
            Rents(t) = CurrentRent
        ElseIf Happens(NextReview, tpstart, tpend) Then
            Rents(t) = CurrentRent * PartialPeriod(tpstart, tpend, NextReview, PmtsPerYear, DayCount, True)
            CurrentRent = GrowTo(NextReview, GrowthDates, GrowthRates) * MktRent / PmtsPerYear
            Rents(t) = Rents(t) + CurrentRent * PartialPeriod(tpstart, tpend, NextReview, PmtsPerYear, DayCount, False)
            NextReview = DateAdd("m", RevMos, NextReview)
        End If
nextt:
    Next t
    a_RentMkt = Align(Rents, Options)
End Function
Function RentMkt(FromDate, ToDate, RentStartDate, FirstReview, ExpOrBrk, MktRent, InitialRent, _
GrowthDates, GrowthRates, RevMos, PmtsPerYear, DayCount, Options)
    Dim IntOptions, CurrentRent, NextReview, LastReview
    IntOptions = Internalise(Options)
    NextReview = FirstReview
    If RevMos <= 0 Then RevMos = 60
    Do While NextReview < FromDate
        NextReview = DateAdd("m", RevMos, NextReview)
    Loop
    LastReview = DateAdd("m", -RevMos, NextReview)
    If ToDate < FirstReview Then
        CurrentRent = InitialRent / PmtsPerYear
    Else
        CurrentRent = GrowTo(LastReview, GrowthDates, GrowthRates) * MktRent / PmtsPerYear
    End If
    RentMkt = 0
    If ToDate <= RentStartDate Or FromDate >= ExpOrBrk Then Exit Function
    If Happens(RentStartDate, FromDate, ToDate) Then
        RentMkt = CurrentRent * PartialPeriod(FromDate, ToDate, RentStartDate, PmtsPerYear, DayCount, False)
    ElseIf Happens(ExpOrBrk, FromDate, ToDate) Then
        RentMkt = CurrentRent * PartialPeriod(FromDate, ToDate, ExpOrBrk, PmtsPerYear, DayCount, True)
    ElseIf (ToDate < NextReview) Then
        RentMkt = CurrentRent
    ElseIf Happens(NextReview, FromDate, ToDate) Then
        RentMkt = CurrentRent * PartialPeriod(FromDate, ToDate, NextReview, PmtsPerYear, DayCount, True)
        CurrentRent = GrowTo(NextReview, GrowthDates, GrowthRates) * MktRent / PmtsPerYear
        RentMkt = RentMkt + CurrentRent * PartialPeriod(FromDate, ToDate, NextReview, PmtsPerYear, DayCount, False)
    End If
End Function
Function a_StepRentMkt(PmtDates, RentStartDate, ExpOrBrk, MktRent, ReviewDates, AnnRents, _
GrowthDates, GrowthRates, RevMos, ReletVoid, ReletRentFree, ReletTerm, DayCount, Options)
    Dim Rents, MktRents, ReletRents, IntOptions, InitialRent, _
            t%, maxr%, FirstReview, maxt%, LeaseStartDate, PmtsPerYear
    PmtsPerYear = PaymentsPerYear(PmtDates)
    IntOptions = Internalise(Options)
    maxt = Dim_Date(PmtDates)
    maxr = Dim_Date(ReviewDates)
    'Stepped Rent Section of primary lease
    Rents = a_StepRent(PmtDates, RentStartDate, ExpOrBrk, ReviewDates, AnnRents, _
                 DayCount, IntOptions)
    InitialRent = GrowTo(ReviewDates(maxr), GrowthDates, GrowthRates) * MktRent
    FirstReview = DateAdd("m", RevMos, ReviewDates(maxr))
    'Market Review Section of primary lease
    MktRents = a_RentMkt(PmtDates, ReviewDates(maxr), FirstReview, ExpOrBrk, MktRent, InitialRent, _
                GrowthDates, GrowthRates, RevMos, DayCount, IntOptions)
    For t = 1 To UBound(Rents)
        Rents(t) = Rents(t) + MktRents(t)
    Next t
    'Reletting
    Do
        LeaseStartDate = DateAdd("m", ReletVoid, ExpOrBrk)
        RentStartDate = DateAdd("m", ReletRentFree, LeaseStartDate)
        If LeaseStartDate > PmtDates.Cells(maxt) Then Exit Do
        ExpOrBrk = DateAdd("m", ReletTerm * 12, LeaseStartDate)
        FirstReview = DateAdd("m", RevMos, LeaseStartDate)
        InitialRent = GrowTo(LeaseStartDate, GrowthDates, GrowthRates) * MktRent
        ReletRents = a_RentMkt(PmtDates, RentStartDate, FirstReview, ExpOrBrk, MktRent, InitialRent, _
                    GrowthDates, GrowthRates, RevMos, DayCount, IntOptions)
        For t = 1 To UBound(Rents)
            Rents(t) = Rents(t) + ReletRents(t)
        Next t
    Loop
    a_StepRentMkt = Align(Rents, Options)
End Function
Function StepRentMkt(FromDate, ToDate, RentStartDate, ExpOrBrk, MktRent, ReviewDates, AnnRents, _
GrowthDates, GrowthRates, RevMos, ReletVoid, ReletRentFree, ReletTerm, PmtsPerYear, DayCount, Options)
    Dim Rents, MyMktRent, ReletRent, IntOptions, InitialRent, _
             maxr%, FirstReview, LeaseStartDate, MyStepRent
    IntOptions = Internalise(Options)
    maxr = Dim_Date(ReviewDates)
    'Stepped Rent Section of primary lease
    MyStepRent = StepRent(FromDate, ToDate, RentStartDate, ExpOrBrk, ReviewDates, AnnRents, _
                PmtsPerYear, DayCount, IntOptions)
    InitialRent = GrowTo(ReviewDates(maxr), GrowthDates, GrowthRates) * MktRent
    FirstReview = DateAdd("m", RevMos, ReviewDates(maxr))
    'Market Review Section of primary lease
    MyMktRent = RentMkt(FromDate, ToDate, ReviewDates(maxr), FirstReview, ExpOrBrk, MktRent, InitialRent, _
                GrowthDates, GrowthRates, RevMos, PmtsPerYear, DayCount, IntOptions)
    'Reletting
    ReletRent = 0
    Do
        LeaseStartDate = DateAdd("m", ReletVoid, ExpOrBrk)
        RentStartDate = DateAdd("m", ReletRentFree, LeaseStartDate)
        If LeaseStartDate > ToDate Then Exit Do
        ExpOrBrk = DateAdd("m", ReletTerm * 12, LeaseStartDate)
        FirstReview = DateAdd("m", RevMos, LeaseStartDate)
        InitialRent = GrowTo(LeaseStartDate, GrowthDates, GrowthRates) * MktRent
        ReletRent = ReletRent + RentMkt(FromDate, ToDate, RentStartDate, FirstReview, ExpOrBrk, MktRent, InitialRent, _
                    GrowthDates, GrowthRates, RevMos, PmtsPerYear, DayCount, IntOptions)
    Loop
    StepRentMkt = MyStepRent + MyMktRent + ReletRent
End Function
Function Happens(TheDate, StartTimePeriod, EndTimePeriod)
    If TheDate >= StartTimePeriod And TheDate < EndTimePeriod Then
        Happens = True
    Else
        Happens = False
    End If
End Function
Function a_StepRent(PmtDates, RentStartDate, ExpOrBrk, ReviewDates, AnnRents, DayCount, Options)
    Dim n%, maxn%, t%, maxt%, tpstart As Date, tpend As Date, r As Date, Amounts(), IntOptions, CurrentRent, PmtsPerYear
    IntOptions = Internalise(Options)
    PmtsPerYear = PaymentsPerYear(PmtDates)
    maxn = Dim_Date(ReviewDates)
    maxt = Dim_Date(PmtDates)
    ReDim Amounts(1 To maxt)
    'n1 = 1
    For t = 1 To maxt
        Amounts(t) = 0
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpstart > ReviewDates.Cells(maxn) Then GoTo nextt
        If tpend <= RentStartDate Then GoTo nextt
        If tpstart >= ExpOrBrk Then GoTo nextt
        'If tpstart < RentStartDate  Then tpstart = RentStartDate
        'Stepped Rent Loop
            For n = 1 To maxn
                r = ReviewDates.Cells(n)
                CurrentRent = AnnRents.Cells(n) / PmtsPerYear
                If tpstart > r Then GoTo nextn
                If Happens(RentStartDate, tpstart, tpend) Then
                    'CurrentRent = AnnRents.Cells(1) / pmtsperyear
                    Amounts(t) = Amounts(t) + CurrentRent * PartialPeriod(tpstart, tpend, RentStartDate, PmtsPerYear, DayCount, False)
                    GoTo nextt
                ElseIf Happens(r, tpstart, tpend) Then
                    Amounts(t) = Amounts(t) + CurrentRent * PartialPeriod(tpstart, tpend, r, PmtsPerYear, DayCount, True)
                    If n < maxn Then
                        CurrentRent = AnnRents.Cells(n + 1) / PmtsPerYear
                        Amounts(t) = Amounts(t) + CurrentRent * PartialPeriod(tpstart, tpend, r, PmtsPerYear, DayCount, False)
                        GoTo nextt
                    End If
                ElseIf Happens(ExpOrBrk, tpstart, tpend) Then
                    Amounts(t) = CurrentRent * PartialPeriod(tpstart, tpend, ExpOrBrk, PmtsPerYear, DayCount, True)
                    GoTo nextt
                ElseIf tpend < r Then
                    Amounts(t) = CurrentRent
                    GoTo nextt
                End If
nextn:
            Next n
        '
nextt:
    Next t
exitfunction:
    a_StepRent = Align(Amounts, Options)
End Function
Function a_StepFrom(PmtDates, Finish, FromDates, AnnRates, DayCount, Options)
    Dim n%, maxn%, t%, maxt%, tpstart As Date, tpend As Date, r As Date, Amounts(), IntOptions, CurrentRate, PmtsPerYear
    IntOptions = Internalise(Options)
    PmtsPerYear = PaymentsPerYear(PmtDates)
    maxn = Dim_Date(FromDates)
    maxt = Dim_Date(PmtDates)
    ReDim Amounts(1 To maxt)
    CurrentRate = 0
    For t = 1 To maxt
        Amounts(t) = 0
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpstart >= Finish Then GoTo nextt
        If tpend <= FromDates.Cells(1) Then GoTo nextt
        'Stepped Rate Loop
        For n = maxn To 1 Step -1
                r = FromDates.Cells(n)
                If r > tpend Then GoTo nextn
                CurrentRate = AnnRates.Cells(n) / PmtsPerYear
                If Happens(r, tpstart, tpend) Then
                    Amounts(t) = Amounts(t) + CurrentRate * PartialPeriod(tpstart, tpend, r, PmtsPerYear, DayCount, False)
                    If (n > 1) Then
                        CurrentRate = AnnRates.Cells(n - 1) / PmtsPerYear
                        Amounts(t) = Amounts(t) + CurrentRate * PartialPeriod(tpstart, tpend, r, PmtsPerYear, DayCount, True)
                    Else
                        CurrentRate = 0
                    End If
                    GoTo nextt
                ElseIf Happens(Finish, tpstart, tpend) Then
                    Amounts(t) = CurrentRate * PartialPeriod(tpstart, tpend, Finish, PmtsPerYear, DayCount, True)
                    GoTo nextt
                Else
                    Amounts(t) = CurrentRate
                    GoTo nextt
                End If
nextn:
            Next n
nextt:
    Next t
exitfunction:
    a_StepFrom = Align(Amounts, Options)
End Function
Function a_Loan(PmtDates, RepDate, RollTo, AdvanceDates, NetAdvances, FromDates, IntRatesPA, DayCount, Options)
    Dim t%, maxt%, tpstart As Date, tpend As Date, r As Date, Amounts(), IntOptions, CurrentRate, PmtsPerYear, IntRates()
    Dim OpenBals(), CloseBals(), Ints(), Prins(), IntAdvs(), Repayment#
    Dim repint As Boolean, repopenbals As Boolean, repprin As Boolean, repintadv As Boolean, repclosebals As Boolean, repintrate As Boolean, reprep As Boolean
    IntOptions = Internalise(Options)
    PmtsPerYear = PaymentsPerYear(PmtDates)
    repint = OptionPresent(1, Options)
    repprin = OptionPresent(2, Options)
    repopenbals = OptionPresent(4, Options)
    repopenbals = OptionPresent(4, Options)
    repclosebals = OptionPresent(8, Options)
    repintadv = OptionPresent(16, Options)
    repintrate = OptionPresent(32, Options)
    reprep = OptionPresent(64, Options)
    maxt = Dim_Date(PmtDates)
    ReDim IntRates(maxt)
    ReDim Ints(maxt)
    ReDim OpenBals(maxt)
    ReDim CloseBals(maxt)
    ReDim Prins(maxt)
    ReDim IntAdvs(maxt)
    ReDim Amounts(1 To maxt)
    Prins = a_MkPmts(PmtDates, AdvanceDates, NetAdvances)
    IntRates = a_AvLevels(PmtDates, RepDate, FromDates, IntRatesPA, c_Internal)
    CurrentRate = 0
    For t = 1 To maxt
        If t > 1 Then
            OpenBals(t) = CloseBals(t - 1)
        Else
            OpenBals(t) = 0
        End If
        If t > 1 Then
            Ints(t) = OpenBals(t) * DiffYrs(tpstart, tpend, DayCount) * IntRates(t - 1)
        Else
            Ints(t) = 0
        End If
        Amounts(t) = 0
        If tpstart >= RepDate Then GoTo nextt
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpstart < RollTo Then
            IntAdvs(t) = Ints(t)
        Else
            IntAdvs(t) = 0
        End If
        Prins(t) = Prins(t) + IntAdvs(t)
        If Happens(RepDate, tpstart, tpend) Then
            Repayment = -OpenBals(t) - Prins(t)
            Prins(t) = Repayment
            If reprep Then Amounts(t) = Amounts(t) + Repayment
        End If
        CloseBals(t) = OpenBals(t) + Prins(t)
        If repopenbals Then
            Amounts(t) = Amounts(t) + OpenBals(t)
        ElseIf repclosebals Then
            Amounts(t) = Amounts(t) + OpenBals(t)
        ElseIf repint Then
            Amounts(t) = Amounts(t) + Ints(t)
        ElseIf repprin Then
            Amounts(t) = Amounts(t) + Prins(t)
        ElseIf repintadv Then
            Amounts(t) = Amounts(t) + IntAdvs(t)
        ElseIf repintrate Then
            Amounts(t) = Amounts(t) + IntRates(t)
        End If
nextt:
    Next t
exitfunction:
    a_Loan = Align(Amounts, Options)
End Function
Function a_AvLevels(PeriodDates, Finish, FromDates, Levels, Options)
    Dim n%, maxn%, t%, maxt%, tpstart As Date, tpend As Date, r As Date, MyLevels(), IntOptions, CurrentLevel, PmtsPerYear
    IntOptions = Internalise(Options)
    PmtsPerYear = PaymentsPerYear(PeriodDates)
    maxn = Dim_Date(FromDates)
    maxt = Dim_Date(PeriodDates)
    ReDim MyLevels(1 To maxt)
    CurrentLevel = 0
    For t = 1 To maxt
        MyLevels(t) = 0
        If t < maxt Then
            tpend = PeriodDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PeriodDates, t, PmtsPerYear)
        End If
        tpstart = PeriodDates.Cells(t)
        If tpstart >= Finish Then GoTo nextt
        If tpend <= FromDates.Cells(1) Then GoTo nextt
        'Stepped Rate Loop
        For n = maxn To 1 Step -1
                r = FromDates.Cells(n)
                If r > tpend Then GoTo nextn
                CurrentLevel = Levels.Cells(n)
                If Happens(r, tpstart, tpend) Then
                    MyLevels(t) = MyLevels(t) + CurrentLevel * PartialPeriod(tpstart, tpend, r, PmtsPerYear, 6, False)
                    If (n > 1) Then
                        CurrentLevel = Levels.Cells(n - 1)
                        MyLevels(t) = MyLevels(t) + CurrentLevel * PartialPeriod(tpstart, tpend, r, PmtsPerYear, 6, True)
                    Else
                        CurrentLevel = 0
                    End If
                    GoTo nextt
                ElseIf Happens(Finish, tpstart, tpend) Then
                    MyLevels(t) = CurrentLevel * PartialPeriod(tpstart, tpend, Finish, PmtsPerYear, 6, True)
                    GoTo nextt
                Else
                    MyLevels(t) = CurrentLevel
                    GoTo nextt
                End If
nextn:
            Next n
nextt:
    Next t
exitfunction:
    a_AvLevels = Align(MyLevels, Options)
End Function
Function StepRent(FromDate, ToDate, RentStartDate, ExpOrBrk, ReviewDates, AnnRents, PmtsPerYear, DayCount, Options)
    Dim n%, maxn%, r As Date, IntOptions, CurrentRent
    IntOptions = Internalise(Options)
    maxn = Dim_Date(ReviewDates)
    StepRent = 0
    If FromDate > ReviewDates.Cells(maxn) Or ToDate <= RentStartDate Or FromDate >= ExpOrBrk Then Exit Function
    For n = 1 To maxn
        r = ReviewDates.Cells(n)
        CurrentRent = AnnRents.Cells(n) / PmtsPerYear
        If Happens(RentStartDate, FromDate, ToDate) Then
            StepRent = StepRent + CurrentRent * PartialPeriod(FromDate, ToDate, RentStartDate, PmtsPerYear, DayCount, False)
            Exit Function
        ElseIf Happens(r, FromDate, ToDate) Then
            StepRent = StepRent + CurrentRent * PartialPeriod(FromDate, ToDate, r, PmtsPerYear, DayCount, True)
            If n < maxn Then
                CurrentRent = AnnRents.Cells(n + 1) / PmtsPerYear
                StepRent = StepRent + CurrentRent * PartialPeriod(FromDate, ToDate, r, PmtsPerYear, DayCount, False)
                Exit Function
            End If
        ElseIf Happens(ExpOrBrk, FromDate, ToDate) Then
            StepRent = CurrentRent * PartialPeriod(FromDate, ToDate, ExpOrBrk, PmtsPerYear, DayCount, True)
            Exit Function
        ElseIf ToDate < r Then
            StepRent = CurrentRent
            Exit Function
        End If
nextn:
    Next n
End Function
Private Function Align(ByRef OutputRange, Options) As Variant
    If Not OptionPresent(c_Internal, Options) And Application.Caller.Rows.Count > 1 Then
        Align = WorksheetFunction.Transpose(OutputRange)
    Else
        Align = OutputRange
    End If
End Function
Public Function GetFormula(x As Range, Optional MaxLen) As String
    On Error Resume Next
    GetFormula = x.Formula
    If Not IsMissing(MaxLen) And MaxLen > 0 And MaxLen < Len(GetFormula) Then GetFormula = Left(GetFormula, MaxLen) + " ..."
    If x.HasArray Then GetFormula = "{" & GetFormula & "}"
End Function
Function GrowTo(ToDate, GrowthDates, GrowthRates) As Double
    Dim n As Integer, maxn As Integer, t As Double, IntOptions
    GrowTo = 1
    maxn = Dim_Date(GrowthDates)
    For n = 1 To maxn
            If ToDate <= GrowthDates.Cells(n) Then
                If ToDate > GrowthDates.Cells(n) Then
                    t = DateDiff(GrowthDates.Cells(n), ToDate, "m") / 12
                    GrowTo = GrowTo * (1 + GrowthRates.Cells(n)) ^ t
                    Exit For
                End If
            Else
                If n < maxn Then
                    t = DateDiff("m", GrowthDates.Cells(n), GrowthDates.Cells(n + 1)) / 12
                Else
                    t = DateDiff("m", GrowthDates.Cells(n), ToDate) / 12
                End If
                GrowTo = GrowTo * (1 + GrowthRates.Cells(n)) ^ t
            End If
    Next n
End Function
Private Function Dim_Date(InputRange) As Integer
    On Error GoTo handler
    For Dim_Date = InputRange.Count To 1 Step -1
        If IsDate(InputRange.Cells(Dim_Date)) Then Exit For
    Next Dim_Date
    Exit Function
handler:
    On Error GoTo 0
End Function
Private Function Dim_NZ(InputRange) As Integer
    On Error GoTo handler
    For Dim_NZ = InputRange.Count To 1 Step -1
        If InputRange.Cells(Dim_NZ) <> 0 Then Exit For
    Next Dim_NZ
handler:
    On Error GoTo 0
End Function
Private Function Dim_Blank(InputRange) As Integer
    On Error GoTo handler
    For Dim_Blank = InputRange.Count To 1 Step -1
        If Not IsNull(InputRange.Cells(Dim_Blank)) Then Exit For
    Next Dim_Blank
handler:
    On Error GoTo 0
End Function
Function a_MkPmts(BudgetPeriods, PaymentDates, Payments)
    Dim t%, maxt%, n%, maxn%, n1%, tpstart, tpend, Amounts, p
    maxt = Dim_Date(BudgetPeriods)
    maxn = Dim_Date(PaymentDates)
    p = PaymentsPerYear(BudgetPeriods)
    ReDim Amounts(1 To maxt)
    n1 = 1
    For t = 1 To maxt
        Amounts(t) = 0
        If t < maxt Then
            tpend = BudgetPeriods.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(BudgetPeriods, t, p)
        End If
        tpstart = BudgetPeriods.Cells(t)
        For n = n1 To maxn
            If PaymentDates.Cells(n) >= tpstart Then
                If PaymentDates.Cells(n) < tpend Then
                    Amounts(t) = Amounts(t) + Payments.Cells(n)
                Else
                    n1 = n
                    Exit For
                End If
            End If
        Next n
    Next t
    a_MkPmts = Align(Amounts, 0)
End Function
Sub ZDArrayToSheet(SourceArray As Variant, DestRange As Range)
  With DestRange.Parent.Parent
    .Names.Add Name:="tempdata", RefersToR1C1:=SourceArray
    With DestRange
      .FormulaArray = "=tempdata"
      .Copy
      .PasteSpecial Paste:=xlValues
    End With
    .Names("wstempdata").Delete
  End With
End Sub
Function MyMin(x, y)
    If x < y Then MyMin = x Else MyMin = y
End Function
Function MyMax(x, y)
    If x > y Then MyMax = x Else MyMax = y
End Function
Function DiffYrs(FromDate, ToDate, DayCount)
    Dim coretime, t1, t2, t3, t4, startstub, endstub
    coretime = Year(ToDate) - Year(FromDate) - 1
    t1 = DateSerial(Year(FromDate), 1, 1)
    t2 = DateSerial(Year(FromDate) + 1, 1, 1)
    t3 = DateSerial(Year(ToDate), 1, 1)
    t4 = DateSerial(Year(ToDate) + 1, 1, 1)
    startstub = PartialPeriod(t1, t2, FromDate, 1, DayCount, False)
    endstub = PartialPeriod(t3, t4, ToDate, 1, DayCount, True)
    'If coretime < 0 Then coretime = 0
    'If startstub < 0 Then startstub = 0
    'If endstub < 0 Then endstub = 0
    DiffYrs = coretime + startstub + endstub
    If DiffYrs < 0 Then DiffYrs = 0
End Function
Function ExtrapLastTime(PaymentDates, t, PmtsPerYear)
    Dim m%, y%, d%
    If t > PmtsPerYear Then
        y = Year(PaymentDates.Cells(t - PmtsPerYear + 1)) + 1
        m = Month(PaymentDates.Cells(t - PmtsPerYear + 1))
        d = Day(PaymentDates.Cells(t - PmtsPerYear + 1))
        If d = 29 Then d = 28
            'If y Mod 4 = 0 And d = 28 And m = 2 Then d = 29
            ExtrapLastTime = DateSerial(y, m, d)
        Else
            ExtrapLastTime = PaymentDates.Cells(t - 1) * 2 - PaymentDates.Cells(t - 1)
        End If
End Function
Function a_ConstantRate(PmtDates, Start, Finish, AnnRate, DayCount, Options)
    Dim n%, maxn%, t%, maxt%, tpstart As Date, tpend As Date, r As Date, Amounts(), IntOptions, Arrears As Boolean, CurrentRent, PmtsPerYear
    Dim CoreActActInPeriod As Boolean
    CoreActActInPeriod = OptionPresent(c_CorActActinPeriod, Options)
    maxt = Dim_Date(PmtDates)
    ReDim Amounts(1 To maxt)
    PmtsPerYear = PaymentsPerYear(PmtDates)
    For t = 1 To maxt
        Amounts(t) = 0
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpend <= Start Then GoTo nextt
        If tpstart >= Finish Then GoTo nextt
        If Happens(Start, tpstart, tpend) Then
            Amounts(t) = AnnRate / PmtsPerYear * PartialPeriod(tpstart, tpend, Start, PmtsPerYear, DayCount, False)
            GoTo nextt
        ElseIf Happens(Finish, tpstart, tpend) Then
            Amounts(t) = AnnRate / PmtsPerYear * PartialPeriod(tpstart, tpend, Finish, PmtsPerYear, DayCount, True)
            GoTo nextt
        Else
            If CoreActActInPeriod Then
                Amounts(t) = AnnRate / PmtsPerYear
            Else
                Amounts(t) = AnnRate / PmtsPerYear * PartialPeriod(tpstart, tpend, tpend, PmtsPerYear, DayCount, True)
            End If
        End If
nextt:
    Next t
exitfunction:
    a_ConstantRate = Align(Amounts, Options)
End Function
Function a_ConstantGrow(PmtDates, Start, Finish, AnnRate, FirstReview, GrowthDates, GrowthRates, RevMos, DayCount, Options)
    Dim Amounts(), IntOptions, maxt%, t%, CurrentRate, NextReview, tpstart, tpend, PmtsPerYear
    IntOptions = Internalise(Options)
    PmtsPerYear = PaymentsPerYear(PmtDates)
    maxt = Dim_Date(PmtDates)
    ReDim Amounts(1 To maxt)
    CurrentRate = AnnRate / PmtsPerYear
    NextReview = FirstReview
    For t = 1 To maxt
        Amounts(t) = 0
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpend <= Start Then GoTo nextt
        If tpstart >= Finish Then GoTo nextt
        If Happens(Start, tpstart, tpend) Then
            Amounts(t) = CurrentRate * PartialPeriod(tpstart, tpend, Start, PmtsPerYear, DayCount, False)
        ElseIf Happens(Finish, tpstart, tpend) Then
            Amounts(t) = CurrentRate * PartialPeriod(tpstart, tpend, Finish, PmtsPerYear, DayCount, True)
        ElseIf (tpend < NextReview) Then
            Amounts(t) = CurrentRate
        ElseIf Happens(NextReview, tpstart, tpend) Then
            Amounts(t) = CurrentRate * PartialPeriod(tpstart, tpend, NextReview, PmtsPerYear, DayCount, True)
            CurrentRate = GrowTo(NextReview, GrowthDates, GrowthRates) * AnnRate / PmtsPerYear
            Amounts(t) = Amounts(t) + CurrentRate * PartialPeriod(tpstart, tpend, NextReview, PmtsPerYear, DayCount, False)
            NextReview = DateAdd("m", RevMos, NextReview)
        Else
            Amounts(t) = CurrentRate
        End If
nextt:
    Next t
    a_ConstantGrow = Align(Amounts, Options)
End Function
Function AddCats(Values, Categories, ChosenCategories)
    Dim v%, c%, maxv%, maxc%, maxv2%
    maxv = Dim_NZ(Values)
    maxv2 = Dim_Blank(Categories)
    If maxv2 < maxv Then maxv = maxv2
    maxc = Dim_Blank(ChosenCategories)
    AddCats = 0
    For v = 1 To maxv
        For c = 1 To maxc
            If Categories(v) = ChosenCategories(c) Then
                 AddCats = AddCats + Values(v)
            End If
        Next c
    Next v
End Function
Function a_Spread(PmtDates, Start, Finish, Total, DayCount)
    Dim AnnRate#, PmtsPerYear%
    PmtsPerYear = PaymentsPerYear(PmtDates)
    AnnRate = Total / DiffYrs(Start, Finish, DayCount)
    a_Spread = a_ConstantRate(PmtDates, Start, Finish, AnnRate, DayCount, 0)
End Function
Function PaymentsPerYear(PaymentDates)
    On Error GoTo handler
    Dim maxt%, t%, LastYear, lastt%, y%, lasty%, lastp%, np%
    maxt = Dim_Date(PaymentDates)
    lastt = 1
    np = 0
    PaymentsPerYear = 0
    For t = 1 To maxt
        y = Year(PaymentDates.Cells(t))
        If y <> lasty And t > 1 Then
            np = np + 1
            lastp = PaymentsPerYear
            PaymentsPerYear = t - lastt
            lastt = t
            If PaymentsPerYear <> lastp And np > 1 Then
                PaymentsPerYear = Err
                Exit Function
            End If
        End If
        lasty = y
    Next t
    Exit Function
handler:
    PaymentsPerYear = Err
End Function
Function a_SCurve(PmtDates, Start, Finish, Total, Skew, Peakness, DayCount, Options)
    Dim mystart, myfinish, PmtsPerYear, t%, maxt%, tpend, tpstart
    Dim d#, a1#, a2#, t1#, t2#, at#
    PmtsPerYear = PaymentsPerYear(PmtDates)
    maxt = Dim_Date(PmtDates)
    ReDim Amounts(1 To maxt)
    For t = 1 To maxt
        Amounts(t) = 0
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpend <= Start Then GoTo nextt
        If tpstart >= Finish Then GoTo nextt
        mystart = MyMax(Start, tpstart)
        myfinish = MyMin(Finish, tpend)
        If (myfinish < mystart) Then GoTo nextt
        d = DiffYrs(Start, Finish, DayCount)
        If mystart <= Start Then
            t1 = 0
        Else
            t1 = (DiffYrs(Start, mystart, DayCount) / d) ^ Skew
        End If
        If (myfinish <= Start) Then
            t2 = 0
        Else
            t2 = (DiffYrs(Start, myfinish, DayCount) / d) ^ Skew
        End If
        'If t1 = 0 Then
         '   a1=
        a1 = -Cos(t1 * pi) + Peakness * t1
        a2 = -Cos(t2 * pi) + Peakness * t2
        at = 2 + Peakness
        Amounts(t) = (a2 - a1) * Total / at
nextt:
    Next t
    a_SCurve = Align(Amounts, Options)
End Function
Function a_SCumCurve(PmtDates, Start, Finish, Total, CumTimes, CumAmt, DayCount, Options)
    Dim mystart, myfinish, PmtsPerYear, t%, maxt%, tpend, tpstart
    Dim d#, a1#, a2#, t1#, t2#
    PmtsPerYear = PaymentsPerYear(PmtDates)
    maxt = Dim_Date(PmtDates)
    ReDim Amounts(1 To maxt)
    For t = 1 To maxt
        Amounts(t) = 0
        If t < maxt Then
            tpend = PmtDates.Cells(t + 1)
        Else
            tpend = ExtrapLastTime(PmtDates, t, PmtsPerYear)
        End If
        tpstart = PmtDates.Cells(t)
        If tpend <= Start Then GoTo nextt
        If tpstart >= Finish Then GoTo nextt
        mystart = MyMax(Start, tpstart)
        myfinish = MyMin(Finish, tpend)
        If (myfinish < mystart) Then GoTo nextt
        d = DiffYrs(Start, Finish, DayCount)
        If mystart <= Start Then
            t1 = 0
        Else
            t1 = DiffYrs(Start, mystart, DayCount) / d
        End If
        If (myfinish <= Start) Then
            t2 = 0
        Else
            t2 = DiffYrs(Start, myfinish, DayCount) / d
        End If
        a1 = Interpol(t1, CumTimes, CumAmt)
        a2 = Interpol(t2, CumTimes, CumAmt)
        Amounts(t) = (a2 - a1) * Total
nextt:
    Next t
    a_SCumCurve = Align(Amounts, Options)
End Function
Function Interpol(XValue, XRange, YRange)
    Dim maxn%, n%, x1#, x2#
    maxn = Dim_NZ(XRange)
    n = Dim_NZ(YRange)
    If n < maxn Then maxn = n
    For n = 1 To maxn
        If XValue >= XRange.Cells(n) Then
            If n < maxn Then
                If XValue <= XRange.Cells(n + 1) Then
                    x1 = XRange.Cells(n)
                    x2 = XRange.Cells(n + 1)
                    Interpol = YRange.Cells(n) + (XValue - x1) / (x2 - x1) * (YRange.Cells(n + 1) - YRange.Cells(n))
                    Exit Function
                End If
            Else
                Interpol = YRange.Cells(n)
                Exit Function
            End If
        End If
    Next n
End Function
Function a_Interpol(XValues, XRange, YRange)
    Dim maxn%, n%, x1#, x2#, Results(), t%
    maxn = Dim_NZ(XRange)
    n = Dim_NZ(YRange)
    ReDim Results(XValues.Count)
    If n < maxn Then maxn = n
    For t = 1 To XValues.Count
        For n = 1 To maxn
            If XValues.Cells(t) >= XRange.Cells(n) Then
                If n < maxn Then
                    If XValues.Cells(t) <= XRange.Cells(n + 1) Then
                        x1 = XRange.Cells(n)
                        x2 = XRange.Cells(n + 1)
                        Results(t) = YRange.Cells(n) + (XValues.Cells(t) - x1) / (x2 - x1) * (YRange.Cells(n + 1) - YRange.Cells(n))
                        GoTo nextt
                    End If
                Else
                    Results(t) = YRange.Cells(n)
                    GoTo nextt
                End If
            End If
        Next n
nextt:
    Next t
    a_Interpol = Align(Results, 0)
End Function
Function SafeLookup(lookup_value, lookup_vector As Range, result_vector As Range, Optional default)
    Dim n%
    For n = lookup_vector.Count To 1 Step -1
        If lookup_vector.Cells(n) <> 0 Or result_vector.Cells(n) <> 0 Then Exit For
    Next n
    If lookup_vector.Rows.Count <> result_vector.Rows.Count Or lookup_vector.Columns.Count <> result_vector.Columns.Count Then
        SafeLookup = Err
        Exit Function
    End If
    If lookup_vector.Rows.Count > 1 Then
        Set lookup_vector = Range(lookup_vector.Cells(1, 1), lookup_vector.Cells(n, 1))
        Set result_vector = Range(result_vector.Cells(1, 1), result_vector.Cells(n, 1))
    Else
        Set lookup_vector = Range(lookup_vector.Cells(1, 1), lookup_vector.Cells(1, n))
        Set result_vector = Range(result_vector.Cells(1, 1), result_vector.Cells(1, n))
    End If
    SafeLookup = WorksheetFunction.Lookup(lookup_value, lookup_vector, result_vector)
    If IsError(SafeLookup) And Not IsMissing(default) Then SafeLookup = default
End Function
Function a_SafeLookup(lookup_values As Range, lookup_vector As Range, result_vector As Range, Optional default)
    Dim n%, val, Results()
    For n = lookup_vector.Count To 1 Step -1
        If lookup_vector.Cells(n) <> 0 Or result_vector.Cells(n) <> 0 Then Exit For
    Next n
    If lookup_vector.Rows.Count <> result_vector.Rows.Count Or lookup_vector.Columns.Count <> result_vector.Columns.Count Then
        a_SafeLookup = Err
        Exit Function
    End If
    If lookup_vector.Rows.Count > 1 Then
        Set lookup_vector = Range(lookup_vector.Cells(1, 1), lookup_vector.Cells(n, 1))
        Set result_vector = Range(result_vector.Cells(1, 1), result_vector.Cells(n, 1))
    Else
        Set lookup_vector = Range(lookup_vector.Cells(1, 1), lookup_vector.Cells(1, n))
        Set result_vector = Range(result_vector.Cells(1, 1), result_vector.Cells(1, n))
    End If
    ReDim Results(lookup_values.Count)
    For n = 1 To lookup_values.Count
        Results(n) = WorksheetFunction.Lookup(lookup_values.Cells(n), lookup_vector, result_vector)
        If IsError(Results(n)) And Not IsMissing(default) Then Results(n) = default
    Next n
    a_SafeLookup = Align(Results, 0)
End Function
Function DescribeDC(DayCount)
    Select Case DayCount
        Case 0:     DescribeDC = "30/360 (PSA)"
        Case 1:     DescribeDC = "ACT/ACT"
        Case 2:     DescribeDC = "ACT/360"
        Case 3:     DescribeDC = "ACT/365"
        Case 4:     DescribeDC = "30E/360"
        Case 6:     DescribeDC = "ACT/ACT in Period"
        Case Else:  DescribeDC = "Unknown Daycount"
    End Select
End Function