Option Explicit
Function AmortSchedTraditional(BeginPrincipal As Double, PeriodRate As Double, Periods As Long, _
Optional ExtraPrin As Double = 0)
Dim Schedule() As Double
Dim Schedule2() As Double
Dim BeginBal As Double
Dim Counter As Long
Dim Counter2 As Long
Dim LevelPay As Double
ReDim Schedule(1 To Periods, 1 To 5) As Double
If ExtraPrin < 0 Then ExtraPrin = 0
BeginBal = BeginPrincipal
LevelPay = Pmt(PeriodRate, Periods, BeginPrincipal) + ExtraPrin
For Counter = 1 To Periods
Schedule(Counter, 1) = BeginBal
Schedule(Counter, 4) = BeginBal * PeriodRate
Schedule(Counter, 3) = IIf((LevelPay  Schedule(Counter, 4)) < BeginBal, _
LevelPay  Schedule(Counter, 4), BeginBal)
Schedule(Counter, 2) = Schedule(Counter, 3) + Schedule(Counter, 4)
Schedule(Counter, 5) = BeginBal  Schedule(Counter, 3)
If Schedule(Counter, 5) < 0.01 Then
Schedule(Counter, 5) = 0
Exit For
End If
BeginBal = Schedule(Counter, 5)
Next
ReDim Schedule2(1 To Counter, 1 To 5) As Double
For Counter2 = 1 To Counter
Schedule2(Counter2, 1) = Schedule(Counter2, 1)
Schedule2(Counter2, 2) = Schedule(Counter2, 2)
Schedule2(Counter2, 3) = Schedule(Counter2, 3)
Schedule2(Counter2, 4) = Schedule(Counter2, 4)
Schedule2(Counter2, 5) = Schedule(Counter2, 5)
Next
AmortSchedTraditional = Schedule2
End Function
Function AmortSchedSpecialPmt(BeginPrincipal As Double, PeriodRate As Double, DesiredPay As Double)
Dim Schedule() As Double
Dim BeginBal As Double
Dim Counter As Long
Dim NperResult As Double
NperResult = NPer(PeriodRate, DesiredPay, BeginPrincipal)
ReDim Schedule(1 To IIf((NperResult  Int(NperResult)) > 0.000001, Int(NperResult) + 1, _
Int(NperResult)), 1 To 5) As Double
BeginBal = BeginPrincipal
For Counter = 1 To UBound(Schedule, 1)
Schedule(Counter, 1) = BeginBal
Schedule(Counter, 4) = BeginBal * PeriodRate
Schedule(Counter, 3) = IIf((DesiredPay  Schedule(Counter, 4)) < BeginBal, _
DesiredPay  Schedule(Counter, 4), BeginBal)
Schedule(Counter, 2) = Schedule(Counter, 3) + Schedule(Counter, 4)
Schedule(Counter, 5) = BeginBal  Schedule(Counter, 3)
If Schedule(Counter, 5) < 0.01 Then
Schedule(Counter, 5) = 0
Exit For
End If
BeginBal = Schedule(Counter, 5)
Next
AmortSchedSpecialPmt = Schedule
End Function
