Financial Loan Sheets

Here we show how it might be useful to use VBA to complete two different kinds of financial loan sheets, including the accrued interest and principal balances, either at the end of each month, or some financial event, such as a payment or drawdown.

Screenshots

Loan 1

Click to view large-sized image

Loan 2

Click to view large-sized image

Interest Rates
Password

VBA Module Code – Loan 1

VBA 

Sub UpdateLoan1()

Dim pswdSheet As String
pswdSheet = Sheets("Pwd").Cells(2, 1)

ActiveSheet.Unprotect Password:=pswdSheet
ActiveSheet.Protect UserInterfaceOnly:=True

Dim wb As Workbook
Dim sh As Worksheet
Dim tblwidth As Long
Dim tblheight As Long
Dim rng As Range
Dim rng2 As Range

Dim VariableInterest As Long

    'Initialize Excel Objects
    Set wbBook = ThisWorkbook
    With wbBook
    Set sh1 = .Worksheets("Loan 1")
    Set sh2 = .Worksheets("2M LIBOR")
    End With

    'Go to first non-empty cell in Column A (where the Table should be)
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Select the Table region and define table width and height
    Set tbl = ActiveCell.CurrentRegion
    'tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
    tblwidth = tbl.Columns.Count - 1
    tblheight = tbl.Rows.Count - 1
    
    'Copy Formulae from last row in Table to next row
    With sh1
    Set rng = .Range(.Cells(ActiveCell.Offset(tblheight, 1).Row, ActiveCell.Offset(tblheight, 1).Column), .Cells(ActiveCell.Offset(tblheight, tblwidth).Row, ActiveCell.Offset(tblheight, tblwidth).Column))
    rng.Copy
    Set rng2 = rng.Offset(1, 0)
    rng2.PasteSpecial Paste:=xlPasteFormulas
    End With
    
    'Reset Active Cell to where it should be - at first non-empty cell in Column A, where the Table starts
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Ensure End Date in new row still shows EoMonth Formula
    ActiveCell.Offset(1, 2).Copy
    ActiveCell.Offset(tblheight + 1, 2).PasteSpecial Paste:=xlPasteFormulas
    
    'Reset Active Cell to where it should be - at first non-empty cell in Column A, where the Table starts
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Clear anything that may have been copied down in the Cash and Drawdown Colums - as these are manually entered
    ActiveCell.Offset(tblheight + 1, 6).ClearContents
    ActiveCell.Offset(tblheight + 1, 7).ClearContents
    
    'Reset Active Cell to where it should be - at first non-empty cell in Column A, where the Table starts
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Interest used for Period
    'Find Variable Interest Rate
    On Error Resume Next
    With sh1
    VariableInterest = Application.WorksheetFunction.EoMonth(ActiveCell.Offset(tblheight + 1, 1), -1) + 1
    ActiveCell.Offset(tblheight + 1, tblwidth + 4).Value = Application.WorksheetFunction.VLookup(CLng(VariableInterest), sh2.Range("A1:B999"), 2, False)
    End With
    
    'Find Fixed Interest Rate
    ActiveCell.Offset(tblheight + 1, tblwidth + 3).Value = sh1.Range("c17").Value
    
    'Calculate Total Interest Rate
    ActiveCell.Offset(tblheight + 1, tblwidth + 2).Value = ActiveCell.Offset(tblheight + 1, tblwidth + 4).Value + ActiveCell.Offset(tblheight + 1, tblwidth + 3).Value

ActiveSheet.Protect Password:=pswdSheet

MsgBox "Loan 1 Done"

End Sub

VBA Module Code – Loan 2

VBA 

Sub UpdateLoan2()

Dim pswdSheet As String
pswdSheet = Sheets("Pwd").Cells(2, 1)

ActiveSheet.Unprotect Password:=pswdSheet
ActiveSheet.Protect UserInterfaceOnly:=True


Dim wb As Workbook
Dim sh As Worksheet
Dim tblwidth As Long
Dim tblheight As Long
Dim rng As Range
Dim rng2 As Range

    'Initialize Excel Objects
    Set wbBook = ThisWorkbook
    With wbBook
    Set sh1 = .Worksheets("Loan 2")
    Set sh2 = .Worksheets("2M LIBOR")
    End With

    'Go to first non-empty cell in Column A (where the Table should be)
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Select the Table region and define table width and height
    Set tbl = ActiveCell.CurrentRegion
    'tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
    tblwidth = tbl.Columns.Count - 1
    tblheight = tbl.Rows.Count - 1
    
    'Copy Formulae from last row in Table to next row
    With sh1
    Set rng = .Range(.Cells(ActiveCell.Offset(tblheight, 1).Row, ActiveCell.Offset(tblheight, 1).Column), .Cells(ActiveCell.Offset(tblheight, tblwidth).Row, ActiveCell.Offset(tblheight, tblwidth).Column))
    rng.Copy
    Set rng2 = rng.Offset(1, 0)
    rng2.PasteSpecial Paste:=xlPasteFormulas
    End With
    
    'Reset Active Cell to where it should be - at first non-empty cell in Column A, where the Table starts
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Ensure End Date in new row still shows EoMonth Formula
    ActiveCell.Offset(1, 2).Copy
    ActiveCell.Offset(tblheight + 1, 2).PasteSpecial Paste:=xlPasteFormulas
    
    'Reset Active Cell to where it should be - at first non-empty cell in Column A, where the Table starts
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Clear anything that may have been copied down in the Cash and Drawdown Colums - as these are manually entered
    ActiveCell.Offset(tblheight + 1, 6).ClearContents
    ActiveCell.Offset(tblheight + 1, 7).ClearContents
    
    'Reset Active Cell to where it should be - at first non-empty cell in Column A, where the Table starts
    sh1.Activate
    With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    End With
    
    'Interest used for Period
    
    'Find Fixed Interest Rate
    ActiveCell.Offset(tblheight + 1, tblwidth + 3).Value = sh1.Range("c17").Value
    
    'Calculate Total Interest Rate
    ActiveCell.Offset(tblheight + 1, tblwidth + 2).Value = ActiveCell.Offset(tblheight + 1, tblwidth + 4).Value + ActiveCell.Offset(tblheight + 1, tblwidth + 3).Value

ActiveSheet.Protect Password:=pswdSheet

MsgBox "Loan 2 Done"

End Sub

Download

The full file can be downloaded here:

VBA - Financial Loan Sheets (xlsm)