In an Excel formula:
=INDEX(AmortSchedTraditional(Begin_Balance,Period_Rate,Periods,Balloon,ExtraPayments),10,1)
=INDEX(AmortSchedTraditional(Begin_Balance,Period_Rate,Periods,Balloon,ExtraPayments),10,2)
=INDEX(AmortSchedTraditional(Begin_Balance,Period_Rate,Periods,Balloon,ExtraPayments),10,3)
=INDEX(AmortSchedTraditional(Begin_Balance,Period_Rate,Periods,Balloon,ExtraPayments),10,4)
=INDEX(AmortSchedTraditional(Begin_Balance,Period_Rate,Periods,Balloon,ExtraPayments),10,5)
----------------------------------------------------
In VBA:
Dim arr As Variant
arr = AmortSchedTraditional(Begin_Balance, Period_Rate, Periods, Balloon, ExtraPayments)
MsgBox "10th start balance amount is: " & arr(10, 1)
MsgBox "10th total payment amount is: " & arr(10, 2)
MsgBox "10th principal payment amount is: " & arr(10, 3)
MsgBox "10th interest payment amount is: " & arr(10, 4)
MsgBox "10th new balance amount is: " & arr(10, 5)
Function AmortSchedTraditional(BeginPrincipal As Currency, PeriodRate As Double, Periods As Long, _
Balloon As Currency, ParamArray ExtraPrin())
' Function by Patrick Matthews
' You are free to use and distribute this function freely, so long as you attribute authorship,
' For more information please see: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/A_3331-Fixed-Rate-Loan-Amortization-Schedule-with-Optional-Extra-Principal-Payments.html
' This function returns an array with the amortization schedule for a loan with known beginning
' principal, period rate, number of periods, 'balloon' balance to be left at the end of the
' amortization schedule, and optional schedule of extra principal payments.
' Notes:
' 1) All arguments should be positive
'
' 2) Period rate is the effective fixed rate assessed each period. For example, if the annual
' rate is 6% and payments are made each month, the the period rate is 6% / 12 = 0.5%
'
' 3) Periods is the stated length of the loan assuming no extra payments. If extra payments
' are made, the effective number of periods may be less than this (unless a Balloon amount
' is specified)
'
' 4) The Balloon argument specifies an amount of the original principal not repaid through the
' scheduled payments.
' a) This may be retired as a lump sum payout at the end of the schedule, or itself may be
' refinanced; in either event, it is not included in the payout schedule
' b) If a Balloon amount is specified, the function will never return a schedule with fewer
' payments than specified in the Periods argument. If necessary, the function will stop
' applying principal payments (i.e., go into "interest only" mode)
' c) The new balance after applying the last payment will always be equal to the balloon
' amount, and the sum of all principal payments will be (BeginPrincipal - Balloon)
' d) Negative balloon amounts are ignored
'
' 5) ExtraPrin allows a highly flexible schedule of extra principal payments
' a) If an array is passed as the first item in ExtraPrin, then only that array gets used.
' Such an array can be one dimensional or two dimensional. (If the array has >2 dimensions,
' only the first 2 get used.)
' b) In all cases, function tries to take elements from ExtraPrin in groups of three. First
' in the group is the amount of the extra payment, 2nd the starting period in which to
' apply the extra amount, 3rd is the ending period in which to apply the extra amount
' c) You can create multiple streams of extra payments, and those streams can overlap. If
' there is an overlap, the extra payments from each stream are added together
' d) If the start period of an extra payment stream is zero or omitted, the start period is
' assumed to be the first period
' e) If the end period of an extra payment stream is zero or omitted, the end period is
' assumed to be the last period
' f) Any extra amount in the extra payments schedule is ignored if it is not >0. No negative
' amortization allowed!
'
' 6) The function considers only the cost of servicing the loan: i.e., the interest and principal
' payments. No provision is made for required "escrow" payments such as for taxes and
' insurance that the lender may require the borrower to pay periodically
'
' 7) The function assumes that there is no penalty for early repayment of the loan
' 8) As these are financial, amounts are held as Currency values. The rounding is controlled by
' a constant, RoundInterval. For the USA, use 0.01 for RoundInterval (rounding to the penny).
' For whatever locale you are working in, change this constant to conform to local rules. For
' example, to round to the nearest quarter-unit of currency, use 0.25. For the nearest half-unit
' use 0.5. To round to the nearest unit, use 1. To round to the nearest 5 units, use 5, etc.
' 9) Since the "level payment" defining the baseline for each scheduled payment almost never lands
' exactly on a multiple of the correct rounding interval, it thus must be rounded. A second
' constant, RoundLevelPmt, controls whether this rounding is unbiased, biased upward, or biased
' downward
' The function returns an array of length (1 To N, 1 To 5), where N is the number of payments
' ultimately needed to retire the loan (may be different from initial Periods argument if extra
' principal payments are made)
' In the second dimension, the values are:
' 1: Balance before payment X
' 2: Total amount of payment X
' 3: Principal amount of payment X
' 4: Interest amount of payment X
' 5: Balance after payment X
' To use this function in Excel, use an array formula. If the array area has more rows than the
' function returns, the 'extra' rows will show a #N/A error. You can use Conditional Formatting
' to dynamically hide such results.
' This function will work in other VBA and VB projects.
Dim Schedule() As Currency
Dim Schedule2() As Currency
Dim BeginBal As Currency
Dim Counter As Long
Dim Counter2 As Long
Dim LevelPay As Currency
Dim NumPayments As Long
Dim ExtraPrinArr() As Currency
Dim ExtraPrinCounter As Long
Dim ApplyToCounter As Long
Dim ApplyToStart As Long
Dim ApplyToEnd As Long
Dim arr As Variant
Dim Is1D As Boolean
' This constant controls how currency figures are rounded. As noted above:
' To nearest hundredth of a unit: 0.01
' To nearest tenth of a unit : 0.1
' To nearest quarter of a unit : 0.25
' To nearest half of a unit : 0.5
' To nearest unit : 1
' To nearest 5 units : 5
' To nearest 10 units : 10
' etc
Const RoundInterval As Currency = 0.01
' This constant controls how the regularly scheduled "level payment" is calculated. Most
' often, the level payment will have to be rounded; if the level payment is rounded up, then
' the last payment will be slightly smaller than the others because in effect you have been
' making tiny (i.e., between zero the rounding interval) extra payments throughout the schedule.
' If the level payment was rounded down, then the last payment will be slightly larger than the
' other payments to make up the shortfall.
' To allow the level payment to be rounded without bias, use 0 for RoundLevelPmt
' To always round the level payment up, use a number greater than 0 for RoundLevelPmt
' To always round the level payment down, use a number less than 0 for RoundLevelPmt
Const RoundLevelPmt As Long = 0
' Make sure arguments are rounded using correct interval
BeginPrincipal = Round(BeginPrincipal / RoundInterval, 0) * RoundInterval
Balloon = Round(Balloon / RoundInterval, 0) * RoundInterval
' Dimension array with 'first pass' amortization schedule
ReDim Schedule(1 To Periods, 1 To 5) As Currency
' Build array for extra payments to principal. Each element of the array holds the extra
' principal payment applicable in that period. Array initializes to zero for each item
ReDim ExtraPrinArr(1 To Periods) As Currency
' Skip if nothing is passed for ExtraPrin argument
If UBound(ExtraPrin) > -1 Then
' Values passed in for extra payments, so evaluate. Where aplicable, round the extra
' amount to correct interval
If Not IsArray(ExtraPrin(0)) Then
' First item was not an array. Process each element of ExtraPrin. Process in groups
' of three. First is extra amount, second is start period, third is end period
For ExtraPrinCounter = 0 To UBound(ExtraPrin) Step 3
' Test to make sure start period is there. If not, assume start = 1
If (ExtraPrinCounter + 1) <= UBound(ExtraPrin) Then
ApplyToStart = ExtraPrin(ExtraPrinCounter + 1)
Else
ApplyToStart = 1
End If
' Reset 0 start to 1
If ApplyToStart < 1 Then
ApplyToStart = 1
End If
' Test to make sure end period is there. If not, assume end = num of periods
If (ExtraPrinCounter + 2) <= UBound(ExtraPrin) Then
ApplyToEnd = ExtraPrin(ExtraPrinCounter + 2)
Else
ApplyToEnd = Periods
End If
' Make sure end does not exceed Periods; reset 0 to num of Periods
If ApplyToEnd > Periods Or ApplyToEnd = 0 Then
ApplyToEnd = Periods
End If
' Use loop to add extra principal amount to the array. Skip zero/negative extra amounts
For ApplyToCounter = ApplyToStart To ApplyToEnd
If ExtraPrin(ExtraPrinCounter) > 0 Then
ExtraPrinArr(ApplyToCounter) = ExtraPrinArr(ApplyToCounter) + _
Round(ExtraPrin(ExtraPrinCounter) / RoundInterval, 0) * RoundInterval
End If
Next
Next
Else
' First element was an array. Determine whether this array is 1-D or 2-D. Trying to find
' upper bound of second dimension will cause an error if the array is 1-D
arr = ExtraPrin(0)
On Error Resume Next
ExtraPrinCounter = UBound(arr, 2)
If Err = 0 Then
Is1D = False
Else
Err.Clear
Is1D = True
End If
On Error GoTo 0
If Is1D Then
' Process elements in groups of three, as above
For ExtraPrinCounter = LBound(arr) To UBound(arr) Step 3
If (ExtraPrinCounter + 1) <= UBound(arr) Then
ApplyToStart = arr(ExtraPrinCounter + 1)
Else
ApplyToStart = 1
End If
If ApplyToStart < 1 Then
ApplyToStart = 1
End If
If (ExtraPrinCounter + 2) <= UBound(arr) Then
ApplyToEnd = arr(ExtraPrinCounter + 2)
Else
ApplyToEnd = Periods
End If
If ApplyToEnd > Periods Or ApplyToEnd = 0 Then
ApplyToEnd = Periods
End If
For ApplyToCounter = ApplyToStart To ApplyToEnd
If arr(ExtraPrinCounter) > 0 Then
ExtraPrinArr(ApplyToCounter) = ExtraPrinArr(ApplyToCounter) + _
Round(arr(ExtraPrinCounter) / RoundInterval, 0) * RoundInterval
End If
Next
Next
Else
' Array is at least 2-D; if there are 3+ dimensions, ignore them. Assume that first
' dimension enumerates the distinct extra payment streams, and that the second
' dimension contains (in this order) the extra amount, the start period, and the end
' period, although the start/end periods can be omitted
For ExtraPrinCounter = LBound(arr, 1) To UBound(arr, 1)
' If lower bound < upper bound, then an element for the start period must be there.
' If it is, get it and evaluate it. If there is no start period element, then the
' start period will always be 1
If LBound(arr, 2) < UBound(arr, 2) Then
ApplyToStart = arr(ExtraPrinCounter, LBound(arr, 2) + 1)
Else
ApplyToStart = 1
End If
If ApplyToStart < 1 Then
ApplyToStart = 1
End If
' If (lower bound + 1) < upper bound, then an element for the end period must be
' there. If it is, get it and evaluate it. If there is no end period element,
' then the end period will always be the last period
If (LBound(arr, 2) + 1) < UBound(arr, 2) Then
ApplyToEnd = arr(ExtraPrinCounter, LBound(arr, 2) + 2)
Else
ApplyToEnd = Periods
End If
If ApplyToEnd > Periods Or ApplyToEnd = 0 Then
ApplyToEnd = Periods
End If
' Determine extra payment amounts for each period. Skip where extra amount is
' zero or negative
For ApplyToCounter = ApplyToStart To ApplyToEnd
If arr(ExtraPrinCounter, LBound(arr, 1)) > 0 Then
ExtraPrinArr(ApplyToCounter) = ExtraPrinArr(ApplyToCounter) + _
Round(arr(ExtraPrinCounter, LBound(arr, 1)) / RoundInterval, 0) * RoundInterval
End If
Next
Next
End If
End If
End If
BeginBal = BeginPrincipal
If Balloon < 0 Then Balloon = 0
' Determine level payment before extra payments and round to appropriate interval. If the number
' is rounded down, the last payment will be slightly larger to make up the shortfall. If rounded
' up, the last payment will be slightly smaller
LevelPay = -Pmt(PeriodRate, Periods, BeginPrincipal, -Balloon)
If RoundLevelPmt > 0 Then
If LevelPay / RoundInterval > Int(LevelPay / RoundInterval) Then
LevelPay = (1 + Int(LevelPay / RoundInterval)) * RoundInterval
Else
LevelPay = Int(LevelPay / RoundInterval) * RoundInterval
End If
ElseIf RoundLevelPmt = 0 Then
LevelPay = Round(LevelPay / RoundInterval, 0) * RoundInterval
Else
LevelPay = Int(LevelPay / RoundInterval) * RoundInterval
End If
' Loop through each scheduled payment
For Counter = 1 To Periods
' Increment actual number of payments made
NumPayments = NumPayments + 1
' Set beginning balance for this payment
Schedule(Counter, 1) = BeginBal
' Interest is easy to determine; do it first. Since all the starting values are already
' rounded appropriately, as long as this one is too then the rest of the values will also
' be rounded correctly
Schedule(Counter, 4) = Round(BeginBal * PeriodRate / RoundInterval, 0) * RoundInterval
' Amount of principal portion depends in part on the remaining balance before the payment
' is applied; the principal amount can never be larger than this. Also curtail principal
' payment so that the new balance never dips below the balloon amount, if applicable
Schedule(Counter, 3) = IIf((LevelPay - Schedule(Counter, 4)) < (BeginBal - Balloon), _
LevelPay - Schedule(Counter, 4), BeginBal - Balloon)
' Apply extra principal if applicable. If a balloon amount is specified, do not apply any
' extra payments if that would bring the new balance under the balloon amount
If ExtraPrinArr(Counter) > 0 Then
If ExtraPrinArr(Counter) <= (BeginBal - Balloon - Schedule(Counter, 3)) Then
Schedule(Counter, 3) = Schedule(Counter, 3) + ExtraPrinArr(Counter)
Else
Schedule(Counter, 3) = Schedule(Counter, 3) + (BeginBal - Balloon - Schedule(Counter, 3))
End If
End If
' Total payment = principal portion + interest portion
Schedule(Counter, 2) = Schedule(Counter, 3) + Schedule(Counter, 4)
' Determine balance after payment is applied. Check for a balance approaching zero
Schedule(Counter, 5) = BeginBal - Schedule(Counter, 3)
If Schedule(Counter, 5) < 0.01 Then
Schedule(Counter, 5) = 0
Exit For
Else
BeginBal = Schedule(Counter, 5)
End If
If Counter = Periods And BeginBal > 0 Then
Schedule(Counter, 2) = Schedule(Counter, 2) + BeginBal
Schedule(Counter, 3) = Schedule(Counter, 3) + BeginBal
Schedule(Counter, 5) = 0
End If
Next
' Create a new array that has only as many 'rows' as there are payments to be made
ReDim Schedule2(1 To NumPayments, 1 To 5) As Currency
For Counter2 = 1 To NumPayments
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
' Assign the function return value
AmortSchedTraditional = Schedule2
End Function
(to open source code in a new tab, click here)
Private Sub Worksheet_Calculate()
With Me.Range("Schedule")
.Rows("1:" & Me.Range("NetPayments").Value).Hidden = False
If Me.Range("NetPayments").Value < .Rows.Count Then
.Rows((Me.Range("NetPayments").Value + 1) & ":" & .Rows.Count).Hidden = True
End If
End With
End Sub
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (16)
Author
Commented:Commented:
Wow... very impressive approach and very informative.
When downloading the XLS and plugging in the numbers (where matching), I didn't see the monthly payment... and it the total price seemed to be way off.
Not questioning the XLS... I'm sure it works great for a mortgage... not sure if it helps me w/ my current question though.
Any additional thoughts?
EEH
Author
Commented:Make sure you have macros enabled. The workbook depends on VBA code to work its voodoo.
With macros enabled, once you enter the loan parameters in B1:B4, your base payment will appear in D1.
Patrick
Commented:
Anthony
Commented:
I am very impressed with your VB code Function amortization schedule with optional extra principal payments. I have used it in an excel macro and it produces an answer very close to what I am looking for. The variable payment amount is I believe the difference (in my case I would want this amount to be fixed over the term of the loan). My question to you has anyone written this VB function in SQL? The reasoning is that we are in the taxi business, offering car loans to drivers repayable weekly over a 2 to 3 year term so integrating this code into our billing software (written in SQL) would work much better for us.
Regards
Chris Bailey
View More