Banker Rounding in VBA?

Question

I am trying to build a Mortgage Amortization calculator using VBA. When I type the formulas in the worksheet and reference each cell to the formula then my calculator works fine. It requires me to drag all my formulas down to duration of the loan. For example, if loan duration is 300 months, I can just drag the formulas to say cell number 300 and it will work fine.

PROBLEM: When I use VBA code to do the same I get essentially a rounding problem where after the end of the term, I don't get a balance of 0.00. I have tried both normal round function and Application.WorksheetFunction.Round and it still yields the same result. Why do my calculations work on the worksheet but when translated into VBA code I get different results? Link to screenshot of my spreadsheet which corresponds to the code:

Option Explicit

Sub Loan2()

Dim i As Integer, LD As Integer
LD = Range("C5").Value
Range("B11", "G1000").ClearContents
Range("B11", "G1000").Interior.ColorIndex = xlNone
For i = 1 To LD
    Cells(10 + i, 2).Value = i 'Payment Period
    Cells(10 + i, 3) = Application.WorksheetFunction.Round(Range("C7").Value, 2) 'Monthly Payment
    Cells(10 + i, 5) = Application.WorksheetFunction.Round(Cells(10 + i - 1, 6) * (Range("C4").Value / 12), 2) 'Interest payment
    Cells(10 + i, 4) = Application.WorksheetFunction.Round(Cells(10 + i, 3).Value - Cells(10 + i, 5).Value, 2) 'Principle payment
    Cells(10 + i, 6).Value = Cells(10 + i - 1, 6).Value - Cells(10 + i, 4).Value 'Balance
    Cells(10 + i, 7) = Cells(10 + i, 4).Value + Cells(10 + i, 5).Value 'Sum of principle and interest.
Next i

End Sub

Answer 1

An alternative to the worksheet function (avoiding bankers' rounding):

Function roundIt(ByVal d As Double, ByVal nDigits As Integer) As Double
' Purpose: avoid so called bankers' rounding in VBA (5 always rounds even)
If nDigits > 0 Then
   ' if european colon instead of point separartor
   ' roundIt= val(Replace(Format(d, "0." & String(nDigits, "0")), ",", "."))
     roundIt= val(Format(d, "0." & String(nDigits, "0")))
Else
   ' if european colon instead of point separartor
   ' roundIt =  val(Replace(Format(d / (10 ^ nDigits), "0."), ",", "."))
   roundIt = val(Format(d / (10 ^ nDigits), "0."))
End If
End Function

Always use "Option explicit" to check your declarations. Code gets more readable if you use a Type structure. Write this in the declaration head of your module.

Option Explicit

Type TLoan
   Interest       As Double
   LD             As Integer
   Principal      As Double
   Annuity        As Double
End Type

Here is your code with some additions

Sub Loan2()
Dim loan As TLoan                                   ' declare loan as of type TLoan
Dim i As Integer                                    ' no more use for LD ", LD As Integer"
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheetName")     ' fully qualified range

With loan
  .Interest = ws.Range("C4").Value
  .LD = ws.Range("C5").Value
  .Principal = ws.Range("C6").Value
  .Annuity = ws.Range("C7").Value
End With

With ws
  .Range("B10").Value = 0
  .Range("F10").Value = loan.Principal              ' principal
  .Range("B11", "G1000").ClearContents
  .Range("B11", "G1000").Interior.ColorIndex = xlNone

  For i = 1 To loan.LD
    .Cells(10 + i, 2).Value = i                     'Payment Period
    .Cells(10 + i, 3) = roundIt(loan.Annuity, 2)   'Monthly Payment
    .Cells(10 + i, 5) = roundIt(.Cells(10 + i - 1, 6) * (loan.Interest / 12), 2) 'Interest payment
    .Cells(10 + i, 4) = roundIt(.Cells(10 + i, 3).Value - .Cells(10 + i, 5).Value, 2) 'Principle payment
    .Cells(10 + i, 6).Value = Cells(10 + i - 1, 6).Value - .Cells(10 + i, 4).Value    'Balance
    .Cells(10 + i, 7) = .Cells(10 + i, 4).Value + .Cells(10 + i, 5).Value             'Sum of principle and interest.
  Next i
End With
End Sub

Additional tip (autofill Routine)

Try to use an autofill routine as shown in "Excel-VBA-autofill multiple cells with formula Excel VBA: AutoFill Multiple Cells with Formulas, if you want to include formulas instead of pure values.

Attention: This code refers to another problem with different ranges! Try and play around.

Sub FillDown()

Dim strFormulas(1 To 3) As Variant

With ThisWorkbook.Sheets("Formeln")
    strFormulas(1) = "=SUM(A2:B2)"
    strFormulas(2) = "=PRODUCT(A2:B2)"
    strFormulas(3) = "=A2/B2"
'    Pattern Formulas
    .Range("C2:E2").Formula = strFormulas
'    AutoFill Target
    .Range("C2:E11").FillDown
End With

End Sub