Amortization schedule for many rows using Excel Macro

0 votes

I am new to Excel VBA and looking for help in editing a macro.

I have three columns Sanctioned Amount, Tenure, and Rate of Interest for 7328 rows.

Data Looks something like this

I already have a functioning VBA script (shown below) to compute the amortization schedule, but instead of manually entering the data, I want it to take the inputs from the three columns, calculate it for 7328 rows, and add the numbers below each other.

I am requesting changing the script below to take the values from 3 columns.

Sub one()

Dim intRate, loanLife, initLoan, payment As Double
Dim yearBegBal, intComp, prinComp, yearEndBal, intTot, prinTot, fvloan As Currency

ActiveSheet.UsedRange.Delete

intRateYrs = InputBox("Input Interest rate (Annual):")
loanLifeYrs = InputBox("Input Loan life (Years):")
initLoan = InputBox("Input Loan amount:")

Application.DisplayAlerts = True
Application.ScreenUpdating = True

intRateMths = (intRateYrs / 100) / 12
loanLifeMths = loanLifeYrs * 12

Cells(4, 2).Value = Format(intRateYrs, "#.##") & " %"
Cells(4, 3).Value = Format(intRateMths, "Percent")
Cells(5, 2).Value = loanLifeYrs
Cells(5, 3).Value = loanLifeMths
Cells(6, 2).Value = Format(initLoan, "Currency")

payment = Pmt(intRateMths, loanLifeMths, -initLoan)
Cells(7, 2).Value = Format(payment, "Currency")

outRow = 10
intTot = 0
prinTot = 0
fvloan = 0

Cells(10, 2).Value = "Beginning Balance"
Cells(10, 3).Value = "Payment"
Cells(10, 4).Value = "Interest"
Cells(10, 5).Value = "Principal"
Cells(10, 6).Value = "End Balance"
Cells(10, 7).Value = "Total Interest"
Cells(10, 8).Value = "Total Principal"
Cells(10, 9).Value = "Total Repaid"
yearBegBal = initLoan

For rowNum = 1 To loanLifeMths
    intComp = yearBegBal * intRateMths
    prinComp = payment - intComp
    yearEndBal = yearBegBal - prinComp

    intTot = intTot + intComp
    prinTot = prinTot + prinComp
    fvloan = intTot + prinTot

    Cells(outRow + rowNum, 1).Value = rowNum
    Cells(outRow + rowNum, 2).Value = Format(yearBegBal, "Currency")
    Cells(outRow + rowNum, 3).Value = Format(payment, "Currency")
    Cells(outRow + rowNum, 4).Value = Format(intComp, "Currency")
    Cells(outRow + rowNum, 5).Value = Format(prinComp, "Currency")
    Cells(outRow + rowNum, 6).Value = Format(yearEndBal, "Currency")
    Cells(outRow + rowNum, 7).Value = Format(intTot, "Currency")
    Cells(outRow + rowNum, 8).Value = Format(prinTot, "Currency")
    Cells(outRow + rowNum, 9).Value = Format(fvloan, "Currency")

    yearBegBal = yearEndBal
Next rowNum

ActiveSheet.Range("A:I").EntireColumn.AutoFit
Rows("11:11").Select
ActiveWindow.FreezePanes = True
Range("A1").Select

Application.DisplayAlerts = False
Application.ScreenUpdating = False


End Sub

This is how the result looks like from one iteration

Oct 16, 2022 in Others by Kithuzzz
• 38,010 points
697 views

1 answer to this question.

0 votes

Try this:

Sub one()

Dim intRate, loanLife, initLoan, payment As Double
Dim yearBegBal, intComp, prinComp, yearEndBal, intTot, prinTot, fvloan As Currency
Dim cell As Range


For Each cell In ThisWorkbook.Sheets(1).Range("B2:B2001")

    'intRateYrs = InputBox("Input Interest rate (Annual):")
    'loanLifeYrs = InputBox("Input Loan life (Years):")
    'initLoan = InputBox("Input Loan amount:")

    intRateYrs = cell.Offset(0, 1).Value
    loanLifeYrs = cell.Value
    initLoan = cell.Offset(0, 2).Value

    lrow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    intRateMths = (intRateYrs / 100) / 12
    loanLifeMths = loanLifeYrs * 12
    With Sheets(2)
    Cells(lrow + 4, 2).Value = Format(intRateYrs, "#.##") & " %"
    Cells(lrow + 4, 3).Value = Format(intRateMths, "Percent")
    Cells(lrow + 5, 2).Value = loanLifeYrs
    Cells(lrow + 5, 3).Value = loanLifeMths
    Cells(lrow + 6, 2).Value = Format(initLoan, "Currency")

    payment = Pmt(intRateMths, loanLifeMths, -initLoan)
    Cells(lrow + 7, 2).Value = Format(payment, "Currency")

    outRow = lrow + 10
    intTot = 0
    prinTot = 0
    fvloan = 0

    Cells(lrow + 10, 2).Value = "Beginning Balance"
    Cells(lrow + 10, 3).Value = "Payment"
    Cells(lrow + 10, 4).Value = "Interest"
    Cells(lrow + 10, 5).Value = "Principal"
    Cells(lrow + 10, 6).Value = "End Balance"
    Cells(lrow + 10, 7).Value = "Total Interest"
    Cells(lrow + 10, 8).Value = "Total Principal"
    Cells(lrow + 10, 9).Value = "Total Repaid"
    yearBegBal = initLoan

    For rowNum = 1 To loanLifeMths
        intComp = yearBegBal * intRateMths
        prinComp = payment - intComp
        yearEndBal = yearBegBal - prinComp

        intTot = intTot + intComp
        prinTot = prinTot + prinComp
        fvloan = intTot + prinTot

        Cells(outRow + rowNum, 1).Value = rowNum
        Cells(outRow + rowNum, 2).Value = Format(yearBegBal, "Currency")
        Cells(outRow + rowNum, 3).Value = Format(payment, "Currency")
        Cells(outRow + rowNum, 4).Value = Format(intComp, "Currency")
        Cells(outRow + rowNum, 5).Value = Format(prinComp, "Currency")
        Cells(outRow + rowNum, 6).Value = Format(yearEndBal, "Currency")
        Cells(outRow + rowNum, 7).Value = Format(intTot, "Currency")
        Cells(outRow + rowNum, 8).Value = Format(prinTot, "Currency")
        Cells(outRow + rowNum, 9).Value = Format(fvloan, "Currency")

        yearBegBal = yearEndBal
    Next rowNum

    ActiveSheet.Range("A:I").EntireColumn.AutoFit
    Rows("11:11").Select
    ActiveWindow.FreezePanes = True
    Range("A1").Select
    End With
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

Next cell

End Sub
answered Oct 17, 2022 by narikkadan
• 63,700 points

Related Questions In Others

0 votes
1 answer

Spell number in excel 2013 using 2 rows

Hello, there are a few steps to ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,670 points
398 views
0 votes
1 answer

How to remove Blank Rows using EPPlus Excel Package Plus

Check this answer here: https://stackoverflow.com/a/49232456/1114531.  It is checking the ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,700 points
2,641 views
0 votes
1 answer

Deleting Empty rows in Excel using VBA

On Error Resume Next worksheet.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 When ...READ MORE

answered Oct 7, 2022 in Others by narikkadan
• 63,700 points
1,108 views
0 votes
1 answer

How do you calculate the Quintile for groups of rows in Excel?

Use this formula: =MAX(1,ROUNDUP(10*PERCENTRANK($C:$C,$C2,4),0)) To divide into whichever many ...READ MORE

answered Oct 17, 2022 in Others by narikkadan
• 63,700 points
930 views
0 votes
0 answers

Convert Rows to Columns with values in Excel using custom format

1 I having a Excel sheet with 1 ...READ MORE

Feb 17, 2022 in Others by Edureka
• 13,670 points
758 views
0 votes
1 answer

Remove formulas from all worksheets in Excel using VBA

Try this : Option Explicit Sub test1() ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,700 points
1,548 views
0 votes
1 answer

Calculate monthly average from daily data without PivotTable

Assuming you have the months in column D enter ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,700 points
1,385 views
0 votes
1 answer

Automate compound annual growth rate (CAGR) calculation

The following PowerPivot DAX formulas worked for ...READ MORE

answered Oct 7, 2022 in Others by narikkadan
• 63,700 points
1,054 views
0 votes
1 answer

Removing specific rows in an Excel file using Azure Data Factory

Under the 'Source' tab, choose the number ...READ MORE

answered Sep 23, 2022 in Others by narikkadan
• 63,700 points
2,112 views
0 votes
1 answer
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP