Multi-Loan Amortisation Schedule

[Zachy]

Hi all!

I am trying to come up with a multi-loan amortisation schedule on excel. Does anyone know how to create one/share an excel template for the amortisation of multiple loans? I am already familiar with the amortisation schedule for one loan

But I can't figure how to create a compact, multi-loan amortisation schedule. Any help is greatly appreciated!

 

[sheetspread]

Try this:

 

[18ecooley]

Try this:

Can you post the code? The full vba is cut off in the video.

 

[sheetspread]

Sub amttables()
Dim x As Integer
Dim y As Integer
Dim LRData As Integer
Dim LRSheet As Integer
Dim Tabname As String
LRData = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To LRData
Tabname = Sheets("Data").Cells(x, 1).Value
Sheets.Add.Name = Tabname
With Sheets(Tabname).Range("A2:F2")
.Value = Array("Period", "Opening Bal", "Payment", "Interest", "Principal", "Ending Bal")
.Font.Bold = True
.Borders(xlEdgeBottom).Weight = xlThin
End With
LRSheet = Sheets("Data").Cells(x, 2).Value
For y = 3 To LRSheet + 2
Sheets(Tabname).Cells(y, 1).Value = y - 2
Sheets(Tabname).Cells(y, 3).Formula = "=Data!$E$" & Tabname + 1
Sheets(Tabname).Cells(y, 4).Formula = "=Data!$C$" & Tabname + 1 & "/12*B" & y
Sheets(Tabname).Cells(y, 5).Formula = "=c" & y & "-D" & y
Sheets(Tabname).Cells(y, 6).Formula = "=B" & y & "-E" & y
Sheets(Tabname).Cells(y, 2).Formula = "=F" & y - 1
Next y
With Sheets(Tabname).Cells(3, 2)
.Formula = "=Data!F" & Tabname + 1
.NumberFormat = .Offset(1, 0).NumberFormat
End With
Sheets(Tabname).Range("D:D").NumberFormat = "#,###.##"
Sheets(Tabname).Range("a3:f" & LRSheet + 3).Interior.ColorIndex = 2
For Each cell In Sheets(Tabname).Range("C" & LRSheet + 3 & ":E" & LRSheet + 3)
cell.Formula = "=sum(" & Cells(3, cell.Column).Address(False, False) & ":" & Cells(LRSheet + 2, cell.Column).Address(False, False) & ")"
cell.Borders(xlEdgeBottom).LineStyle = xlDouble
cell.Borders(xlEdgeTop).Weight = xlThin
Next cell
ActiveSheet.Columns.AutoFit
Next x
End Sub

 

[18ecooley]

Sub amttables()
Dim x As Integer
Dim y As Integer
Dim LRData As Integer
Dim LRSheet As Integer
Dim Tabname As String
LRData = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To LRData
Tabname = Sheets("Data").Cells(x, 1).Value
Sheets.Add.Name = Tabname
With Sheets(Tabname).Range("A2:F2")
.Value = Array("Period", "Opening Bal", "Payment", "Interest", "Principal", "Ending Bal")
.Font.Bold = True
.Borders(xlEdgeBottom).Weight = xlThin
End With
LRSheet = Sheets("Data").Cells(x, 2).Value
For y = 3 To LRSheet + 2
Sheets(Tabname).Cells(y, 1).Value = y - 2
Sheets(Tabname).Cells(y, 3).Formula = "=Data!$E$" & Tabname + 1
Sheets(Tabname).Cells(y, 4).Formula = "=Data!$C$" & Tabname + 1 & "/12*B" & y
Sheets(Tabname).Cells(y, 5).Formula = "=c" & y & "-D" & y
Sheets(Tabname).Cells(y, 6).Formula = "=B" & y & "-E" & y
Sheets(Tabname).Cells(y, 2).Formula = "=F" & y - 1
Next y
With Sheets(Tabname).Cells(3, 2)
.Formula = "=Data!F" & Tabname + 1
.NumberFormat = .Offset(1, 0).NumberFormat
End With
Sheets(Tabname).Range("D:D").NumberFormat = "#,###.##"
Sheets(Tabname).Range("a3:f" & LRSheet + 3).Interior.ColorIndex = 2
For Each cell In Sheets(Tabname).Range("C" & LRSheet + 3 & ":E" & LRSheet + 3)
cell.Formula = "=sum(" & Cells(3, cell.Column).Address(False, False) & ":" & Cells(LRSheet + 2, cell.Column).Address(False, False) & ")"
cell.Borders(xlEdgeBottom).LineStyle = xlDouble
cell.Borders(xlEdgeTop).Weight = xlThin
Next cell
ActiveSheet.Columns.AutoFit
Next x
End Sub

Thank you!