• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Amortization Table VBA

M

mandewho

New Member
Hi all,

I am trying to create a VBA that will generate an amortization schedule most of the code works aside from one thing.
I need it to count the leap year as 366 days in 2024 for the compounding annually, but it takes it as 365 days. Could you please guide me to the right direction?
Thanks!
Code: 
Sub CreateLoanSchedule()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "Loan Schedule"
    
    ' Input variables
    Dim loanAmount As Double
    Dim annualRate As Double
    Dim startDate As Date
    Dim endDate As Date
    Dim totalYears As Integer
    Dim balance As Double
    Dim interest As Double
    Dim accruedInterest As Double
    
    ' Get user inputs
    loanAmount = InputBox("Enter the loan amount:")
    annualRate = InputBox("Enter the annual interest rate (as a percentage):") / 100
    startDate = InputBox("Enter the loan start date (MM/DD/YYYY):")
    endDate = InputBox("Enter the loan end date (MM/DD/YYYY):")
    
    ' Calculate total years
    totalYears = DateDiff("yyyy", startDate, endDate)
    
    ' Add loan details
    ws.Cells(1, 1).Value = "Loan Amount:"
    ws.Cells(1, 2).Value = loanAmount
    ws.Cells(2, 1).Value = "Annual Interest Rate:"
    ws.Cells(2, 2).Value = annualRate * 100 & "%"
    ws.Cells(3, 1).Value = "Loan Start Date:"
    ws.Cells(3, 2).Value = startDate
    ws.Cells(4, 1).Value = "Loan End Date:"
    ws.Cells(4, 2).Value = endDate
    ws.Cells(5, 1).Value = "Total Years:"
    ws.Cells(5, 2).Value = totalYears
    
    ' Set up headers for the amortization schedule
    ws.Cells(7, 1).Value = "Payment Date"
    ws.Cells(7, 2).Value = "EOMONTH Formula"
    ws.Cells(7, 3).Value = "Principal Balance"
    ws.Cells(7, 4).Value = "Additional Draws/Paydowns"
    ws.Cells(7, 5).Value = "Principal +/- Additional Draws/Paydowns"
    ws.Cells(7, 6).Value = "Accrued Interest"
    
    ' Initialize balance
    balance = loanAmount
    accruedInterest = 0
    
    ' Loop through each month
    Dim i As Integer
    Dim paymentDate As Date
    paymentDate = startDate
    For i = 1 To totalYears * 12
        accruedInterest = balance * (annualRate / 360) * DateDiff("d", paymentDate, DateAdd("m", 12, paymentDate))
        
        ' Write to worksheet
        If i = 1 Then
            ws.Cells(i + 7, 1).Value = paymentDate
        Else
            ws.Cells(i + 7, 1).Formula = "=(B" & (i + 6) & ") + 1"
        End If
        
        If (i) Mod 13 = 0 Then
            ws.Cells(i + 7, 2).Formula = "=DATE(YEAR(A" & (i - 5) & ") + 1, MONTH(A" & (i - 5) & "), DAY(A" & (i - 5) & ")) - 1"
        Else
            ws.Cells(i + 7, 2).Formula = "=EOMONTH(" & ws.Cells(i + 7, 1).Address & ", 0)"
        End If

        
        
        ws.Cells(i + 7, 2).NumberFormat = "mm/dd/yyyy"
        ws.Cells(i + 7, 3).Value = balance
        ws.Cells(i + 7, 4).Value = 0
        ws.Cells(i + 7, 5).Value = balance
        ws.Cells(i + 7, 6).Formula = "=" & ws.Cells(i + 7, 3).Address & "*(" & annualRate & "/360)*(DAY(" & ws.Cells(i + 7, 2).Address & ")-Day(" & ws.Cells(i + 7, 1).Address & ")+1)"
        
        ' Update payment date
        If (i) Mod 13 = 0 Then
            balance = balance + accruedInterest
            accruedInterest = 0
            paymentDate = DateAdd("yyyy", 1, startDate)
        Else
            paymentDate = DateAdd("m", 1, paymentDate)
        End If
    Next i
    
    ' Format columns
    ws.Columns("A:G").AutoFit
    ws.Range("A8:A" & totalYears * 12 + 7).NumberFormat = "mm/dd/yyyy"
End Sub
 
This was resolved by adding a cumulative column and adding the balance every 13 lines, then resetting the cumulative interest
Code: 
Sub CreateLoanSchedule()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "Loan Schedule"
   
    ' Input variables
    Dim loanAmount As Double
    Dim annualRate As Double
    Dim startDate As Date
    Dim endDate As Date
    Dim totalYears As Integer
    Dim balance As Double
    Dim accruedInterest As Double
   
    ' Get user inputs
    loanAmount = InputBox("Enter the loan amount:")
    annualRate = InputBox("Enter the annual interest rate (as a percentage):") / 100
    startDate = InputBox("Enter the loan start date (MM/DD/YYYY):")
    endDate = InputBox("Enter the loan end date (MM/DD/YYYY):")
   
    ' Calculate total years
    totalYears = DateDiff("yyyy", startDate, endDate)
   
    ' Add loan details
    ws.Cells(1, 1).Value = "Loan Amount:"
    ws.Cells(1, 2).Value = loanAmount
    ws.Cells(2, 1).Value = "Annual Interest Rate:"
    ws.Cells(2, 2).Value = annualRate * 100 & "%"
    ws.Cells(3, 1).Value = "Loan Start Date:"
    ws.Cells(3, 2).Value = startDate
    ws.Cells(4, 1).Value = "Loan End Date:"
    ws.Cells(4, 2).Value = endDate
    ws.Cells(5, 1).Value = "Total Years:"
    ws.Cells(5, 2).Value = totalYears
   
    ' Set up headers for the amortization schedule
    ws.Cells(7, 1).Value = "Payment Date"
    ws.Cells(7, 2).Value = "EOMONTH Formula"
    ws.Cells(7, 3).Value = "Principal Balance"
    ws.Cells(7, 4).Value = "Additional Draws/Paydowns"
    ws.Cells(7, 5).Value = "Principal +/- Additional Draws/Paydowns"
    ws.Cells(7, 6).Value = "Accrued Interest"
    ws.Cells(7, 7).Value = "Cumulative Interest" ' Column header for cumulative interest
   
    ' Initialize balance
    balance = loanAmount
    accruedInterest = 0
   
    ' Loop through each month
    Dim i As Integer
    Dim paymentDate As Date
    paymentDate = startDate
    For i = 1 To totalYears * 12
        accruedInterest = balance * (annualRate / 360) * DateDiff("d", paymentDate, DateAdd("m", 12, paymentDate))
       
        ' Write to worksheet
        If i = 1 Then
            ws.Cells(i + 7, 1).Value = paymentDate
        Else
            ws.Cells(i + 7, 1).Formula = "=(B" & (i + 6) & ") + 1"
        End If
       
        If (i) Mod 13 = 0 Then
            ws.Cells(i + 7, 2).Formula = "=DATE(YEAR(A" & (i - 5) & ") + 1, MONTH(A" & (i - 5) & "), DAY(A" & (i - 5) & ")) - 1"
        Else
            ws.Cells(i + 7, 2).Formula = "=EOMONTH(" & ws.Cells(i + 7, 1).Address & ", 0)"
        End If


        ws.Cells(i + 7, 2).NumberFormat = "mm/dd/yyyy"
        ws.Cells(i + 7, 3).Value = balance
        ws.Cells(i + 7, 4).Value = 0
        ws.Cells(i + 7, 5).Value = balance
        ws.Cells(i + 7, 6).Formula = "=" & ws.Cells(i + 7, 3).Address & "*(" & annualRate & "/360)*(DAY(" & ws.Cells(i + 7, 2).Address & ")-Day(" & ws.Cells(i + 7, 1).Address & ")+1)"
       
        ' Formula for cumulative interest in Column 7
        If i Mod 13 = 1 Then
            ws.Cells(i + 7, 7).Formula = "=" & ws.Cells(i + 7, 6).Address ' Start of new 13-row cycle
        Else
            ws.Cells(i + 7, 7).Formula = "=" & ws.Cells(i + 6, 7).Address & "+" & ws.Cells(i + 7, 6).Address ' Sum of accrued interest
        End If
       
        ' Update balance every 13 rows
        If (i) Mod 13 = 0 Then
            balance = balance + ws.Cells(i + 7, 7).Value ' Compound balance by adding cumulative interest
        End If
       
        ' Update payment date
        If (i) Mod 13 = 0 Then
            paymentDate = DateAdd("yyyy", 1, startDate)
        Else
            paymentDate = DateAdd("m", 1, paymentDate)
        End If
    Next i
   
    ' Format columns
    ws.Columns("A:G").AutoFit
    ws.Range("A8:A" & totalYears * 12 + 7).NumberFormat = "mm/dd/yyyy"
End Sub
 
You must log in or register to reply here.
Back
Top