├── VBA project.pdf ├── VBA project.xlsm ├── Loan amortization.xlsm ├── Mean variance portofolio analysis Github.xlsm ├── README.md ├── Portfolio mean variance analysis VBA code.txt └── Loan amortization VBA code.txt /VBA project.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ShenJianWHy/VBA-Excel-Application-in-Financial-Modeling/HEAD/VBA project.pdf -------------------------------------------------------------------------------- /VBA project.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ShenJianWHy/VBA-Excel-Application-in-Financial-Modeling/HEAD/VBA project.xlsm -------------------------------------------------------------------------------- /Loan amortization.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ShenJianWHy/VBA-Excel-Application-in-Financial-Modeling/HEAD/Loan amortization.xlsm -------------------------------------------------------------------------------- /Mean variance portofolio analysis Github.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ShenJianWHy/VBA-Excel-Application-in-Financial-Modeling/HEAD/Mean variance portofolio analysis Github.xlsm -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # VBA & Excel Application in Financial Modeling 2 | - loan amortization 3 | - mean variance portfolio analysis 4 | - writting a series of financial VBA class (modules) and functions for portfolio performance analysis, stock price simulation, Merton interest rate simulation, binomial tree for option pricing, option greeks, American digital option pricing and spread option pricing using quadrinomial tree. (please view this project via the following pdf summary (VBA project.pdf) https://github.com/ShenJianWHy/VBA-Excel-Application-in-Financial-Modeling/blob/master/VBA%20project.pdf) 5 | -------------------------------------------------------------------------------- /Portfolio mean variance analysis VBA code.txt: -------------------------------------------------------------------------------- 1 | Option Explicit 2 | Option Base 1 3 | Public Function getMonthlyPortLogRet(asset1 As Range, asset2 As Range, proportionAsset1 As Double, Optional flag As Boolean) As Variant 4 | 5 | Dim n1 As Integer, n2 As Integer 6 | Dim ret1() As Variant, ret2() As Variant, temp() As Variant 7 | Dim i As Integer 8 | 9 | n1 = asset1.Rows.Count 10 | n2 = asset2.Rows.Count 11 | 12 | If n1 <> n2 Then 13 | getMonthlyPortLogRet = "Counts not equal" 14 | Exit Function 15 | End If 16 | 17 | ReDim ret1(n1 - 1, 1) 18 | ReDim ret2(n1 - 1, 1) 19 | ReDim temp(n1 - 1, 1) 20 | 21 | If flag = False Then 22 | For i = 1 To n1 - 1 23 | ret1(i, 1) = Log(asset1.Cells(i + 1, 1) / asset1.Cells(i, 1)) 24 | ret2(i, 1) = Log(asset2.Cells(i + 1, 1) / asset2.Cells(i, 1)) 25 | temp(i, 1) = ret1(i, 1) * proportionAsset1 + ret2(i, 1) * (1 - proportionAsset1) 26 | Next i 27 | Else 28 | For i = 1 To n1 - 1 29 | ret1(i, 1) = Log(asset1.Cells(i, 1) / asset1.Cells(i + 1, 1)) 30 | ret2(i, 1) = Log(asset2.Cells(i, 1) / asset2.Cells(i + 1, 1)) 31 | temp(i, 1) = ret1(i, 1) * proportionAsset1 + ret2(i, 1) * (1 - proportionAsset1) 32 | Next i 33 | End If 34 | 35 | getMonthlyPortLogRet = temp 36 | 37 | End Function 38 | 39 | Public Function portfolio_mean_return(asset1 As Range, asset2 As Range, proportionAsset1 As Double, Optional flag As Boolean) As Variant 40 | 41 | portfolio_mean_return = Application.Average(getMonthlyPortLogRet(asset1, asset2, proportionAsset1, flag)) * 12 'annulize average monthly return 42 | 43 | End Function 44 | 45 | 46 | Public Function portfolio_variance(asset1 As Range, asset2 As Range, proportionAsset1 As Double, Optional flag As Boolean) As Variant 47 | 48 | 'Call getMonthlyPortLogRet(asset1, asset2, proportionAsset1) defined before 49 | 50 | portfolio_variance = Application.Var_P(getMonthlyPortLogRet(asset1, asset2, proportionAsset1, flag)) * 12 51 | 52 | End Function 53 | 54 | Public Function sharpe_ratio(asset1 As Range, asset2 As Range, proportionAsset1 As Double, riskFree As Range, Optional flag As Boolean) As Variant 55 | Dim rf As Double 56 | Dim n, i As Integer 57 | Dim ret(), tem() As Variant 58 | n = riskFree.Rows.Count 59 | ReDim ret(n - 1, 1) 60 | ReDim tem(n - 1, 1) 61 | If flag = False Then 62 | For i = 1 To n - 1 63 | ret(i, 1) = Log(riskFree.Cells(i + 1, 1) / riskFree.Cells(i, 1)) 64 | Next i 65 | Else 66 | For i = 1 To n - 1 67 | ret(i, 1) = Log(riskFree.Cells(i, 1) / riskFree.Cells(i + 1, 1)) 68 | Next i 69 | End If 70 | rf = Application.Average(ret) * 12 71 | sharpe_ratio = (portfolio_mean_return(asset1, asset2, proportionAsset1, flag) - rf) _ 72 | / (Sqr(portfolio_variance(asset1, asset2, proportionAsset1, flag)) * Sqr(12)) 73 | 74 | End Function 75 | 76 | 77 | Sub Portfolio_Analysis() 78 | '________________________________________________________________________ 79 | 80 | '********************************************************************** 81 | 'to see whether the data is sorted from the oldest to the newest or not 82 | 'and give boolean value to variable denote(used in UDFs) 83 | '********************************************************************** 84 | Dim denote As Boolean 'using denote to indecate the price is sorted from oldest to newsest(denote=false);true for opsite situation 85 | 86 | If Cells(6, 1).Value < Cells(7, 1).Value Then 87 | denote = False 88 | Else 89 | denote = True 90 | End If 91 | Debug.Print "denote", denote 92 | 93 | Range("Y14").Value = denote 94 | 95 | '________________________________________________________________________ 96 | 97 | Dim n1, n2 As Integer 98 | Dim ws As Worksheet 99 | Dim lastrow As Integer 100 | Dim i, j As Integer 101 | 102 | Set ws = ThisWorkbook.Worksheets("PortAnalysis") 103 | ws.Activate 104 | lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'get the index of lastrow of original data 105 | 106 | Debug.Print lastrow 107 | '********************************************************************** 108 | 'get monthly log return data for two risky assets and riskfree asset 109 | '********************************************************************** 110 | 111 | For i = 7 To lastrow 112 | Cells(i, 3).Value = Log(Cells(i, 2) / Cells(i - 1, 2)) 'return of asset 1 113 | Cells(i, 6).Value = Log(Cells(i, 5) / Cells(i - 1, 5)) 'return of asset 2 114 | Cells(i, 9).Value = Log(Cells(i, 8) / Cells(i - 1, 8)) 'riskfree asset 115 | 116 | Next i 117 | 'unify format 118 | Range("C7:C" & lastrow).NumberFormat = "0.00%" 119 | Range("F7:F" & lastrow).NumberFormat = "0.00%" 120 | Range("I7:I" & lastrow).NumberFormat = "0.00%" 121 | Dim rng1, rng2, rng3, rng As Range 122 | Set rng1 = Range("C7:C" & lastrow) 123 | Set rng2 = Range("F7:F" & lastrow) 124 | Set rng3 = Range("I7:I" & lastrow) 125 | Set rng = Union(rng1, rng2, rng3) 126 | With rng 127 | .NumberFormat = "0.000%" 128 | .Interior.ThemeColor = xlThemeColorAccent6 129 | .Interior.PatternColorIndex = xlAutomatic 130 | .Interior.TintAndShade = 0.799981688894314 131 | End With 132 | '********************************************************************** 133 | 'get expected return, std deviation, correlation matrix, variance-covariance matrix(VCV matrix) 134 | 'note that we annualize the output 135 | '********************************************************************** 136 | Range("O5").Value = Application.Average(Range("I6:I" & lastrow)) * 12 'calculate riskfree rate using 13-week TBills rate 137 | Range("L5").Value = Application.Average(Range("C7:C" & lastrow)) * 12 'calculate annualized expected return of asset1 138 | Range("L6").Value = Application.Average(Range("F7:F" & lastrow)) * 12 'calculate annualizedexpected return of asset2 139 | 'calculate std deviation 140 | Range("M5").Value = Application.StDev_P(Range("C7:C" & lastrow)) * Sqr(12) 141 | Range("M6").Value = Application.StDev_P(Range("F7:F" & lastrow)) * Sqr(12) 142 | 'calculate variance-covariance matrix(VCV) and Correlation Matrix 143 | 144 | Range("L9").Value = Application.Correl(rng1, rng1) 145 | Range("M9").Value = Application.Correl(rng1, rng2) 146 | Range("M10").Value = Application.Correl(rng2, rng2) 147 | Range("L10").Value = Range("M9") 'covariance-variance matrix is symetric 148 | 149 | Range("P9:P10").FormulaArray = _ 150 | "=MMULT(MINVERSE(L13:M14),U9:U10)/MMULT(TRANSPOSE(U9:U10),MMULT(MINVERSE(L13:M14),U9:U10))" 151 | Range("P13:P14").FormulaArray = _ 152 | "=MMULT(MINVERSE(L13:M14),(L5:L6-O5*U9:U10)/MMULT(TRANSPOSE(U9:U10),MMULT(MINVERSE(L13:M14),(L5:L6-O5*U9:U10))))" 153 | 154 | Range("L13").Value = Application.Covar(rng1, rng1) * 12 155 | Range("M13").Value = Application.Covar(rng1, rng2) * 12 156 | Range("M14").Value = Application.Covar(rng2, rng2) * 12 'Anualized 157 | Range("L14").Value = Range("M13") 158 | 159 | Range("S9").Formula = "=SUMPRODUCT($L$5:$L$6,P9:P10)" 160 | Range("T10").FormulaArray = "=SQRT(MMULT(TRANSPOSE(P9:P10),MMULT(($L$13:$M$14),P9:P10)))" 161 | Range("S13").Formula = "=SUMPRODUCT($L$5:$L$6,P13:P14)" 162 | Range("T14").FormulaArray = "=SQRT(MMULT(TRANSPOSE(P13:P14),MMULT(($L$13:$M$14),P13:P14)))" 163 | 164 | 165 | 166 | 'std deviation of minimal variance portfolio 167 | Range("S10").Value = Sqr(portfolio_variance(Range("B6:B" & lastrow), Range("E6:E" & lastrow), Range("P9"), denote)) 168 | 'std deviation of Optimal Risky Portfolio(the tangent point) 169 | Range("S14").Value = Sqr(portfolio_variance(Range("B6:B" & lastrow), Range("E6:E" & lastrow), Range("P13"), denote)) 170 | 171 | 172 | '********************************************************************** 173 | 'Data output -- different portfolio std deviations & sharp ratio & portfolio return 174 | 'with respect to different assets weights 175 | '********************************************************************** 176 | 177 | 178 | Set rng1 = Range("B6:B" & lastrow) 179 | Set rng2 = Range("E6:E" & lastrow) 180 | Set rng3 = Range("H6:H" & lastrow) 181 | For i = 23 To 66 182 | Cells(i, 13).Formula = _ 183 | "= Sqrt(portfolio_variance((" + rng1.Address + "),(" + rng2.Address + ")," + Cells(i, 11).Address(False, False) + " , Y14))" 184 | Cells(i, 14).Formula = "=portfolio_mean_return((" + rng1.Address + "),(" + rng2.Address + ")," + Cells(i, 11).Address(False, False) + " , Y14)" 185 | 186 | Cells(i, 16).Formula = "= sharpe_ratio((" + rng1.Address + "),(" + rng2.Address + "), " + Cells(i, 11).Address(False, False) + ",(" + rng3.Address + "), Y14)" 187 | Range("M23:N65").NumberFormat = "0.00%" 188 | Cells(i, 12).Formula = _ 189 | "= portfolio_variance((" + rng1.Address + "),(" + rng2.Address + ")," + Cells(i, 11).Address(False, False) + " , Y14)" 190 | Next i 191 | 192 | Range("L67").Formula = _ 193 | "= portfolio_variance((" + rng1.Address + "),(" + rng2.Address + ")," + Range("k67").Address(False, False) + " , Y14)" 194 | Range("L68").Formula = _ 195 | "= portfolio_variance((" + rng1.Address + "),(" + rng2.Address + ")," + Range("K68").Address(False, False) + " , Y14)" 196 | Range("O66") = Range("N66") 197 | 198 | '********************************************************************** 199 | 'Chart the sharpe ratio regarding with regard to differentportfoio weights 200 | ' 201 | '********************************************************************** 202 | Dim x_axis, y_axis As Range 203 | Dim cht As Object 204 | Set x_axis = Range("K23:K65") 205 | Set y_axis = Range("P23:P65") 206 | 'Create a chart 207 | Set cht = ActiveSheet.ChartObjects.Add( _ 208 | Left:=Range("U35").Left, _ 209 | Width:=350, _ 210 | Top:=Range("U35").Top, _ 211 | Height:=250) 212 | 'Give chart some data 213 | cht.Chart.SetSourceData Source:=y_axis 214 | cht.Chart.SeriesCollection(1).XValues = x_axis 215 | 'Determine the chart type 216 | cht.Chart.ChartType = xlXYScatterSmoothNoMarkers 217 | With cht 218 | .Chart.HasTitle = True 219 | .Chart.ChartTitle.Text = _ 220 | "Sharpe ratio of different portfolio weights" 221 | .Chart.HasLegend = False 222 | End With 223 | End Sub 224 | 225 | 226 | 227 | Sub clearResult() 'clear contents in current worksheet 228 | ThisWorkbook.Worksheets("PortAnalysis").Activate 229 | Dim lastrow As Integer 230 | Dim rng As Range 231 | Set rng = Union(Range("P9:P10"), Range("P13:P14"), Range("S9:S10"), Range("S13:S14"), Range("T10"), Range("T14")) 232 | lastrow = Cells(Rows.Count, "A").End(xlUp).Row 233 | 234 | Range("C7:C" & lastrow).clear 235 | Range("F7:F" & lastrow).clear 236 | Range("I7:I" & lastrow).clear 237 | Range("L5:M6").ClearContents 238 | Range("L9:M10").ClearContents 239 | Range("L13:M14").ClearContents 240 | Range("O5").ClearContents 241 | rng.ClearContents 242 | Range("L23:P66").ClearContents 243 | Range("L67:L68").ClearContents 244 | 'Delete all charts except for one charts with a specific name "Chart1" 245 | Dim co As ChartObject 246 | For Each co In Sheets("PortAnalysis").ChartObjects 247 | If co.Name <> "Chart1" Then 248 | co.Delete 249 | End If 250 | Next 251 | 252 | 253 | End Sub 254 | 255 | 256 | 257 | -------------------------------------------------------------------------------- /Loan amortization VBA code.txt: -------------------------------------------------------------------------------- 1 | Option Base 1 2 | Private Sub ExitButon_Click() 3 | 4 | AmortizationCaculator.Hide 5 | 6 | End Sub 7 | 8 | Private Sub clear_Click() 9 | Worksheets("LoanAmor").Activate 10 | Range("D13:X1048576").clear 11 | Range("F4:i7").ClearContents 12 | 13 | 'clear all charts 14 | Dim co As ChartObject 15 | For Each co In Sheets("LoanAmor").ChartObjects 16 | co.Delete 17 | Next 18 | 'cealr inputs table 19 | Range("B4:B9").ClearContents 20 | End Sub 21 | 22 | Private Sub complete_Click() 23 | Worksheets("LoanAmor").Activate 24 | '================================================================================ 25 | 'Before the calculation, clear the data calculated last time initially 26 | Range("D13:X1048576").clear 27 | Range("F4:i7").ClearContents 28 | 29 | 'clear all charts 30 | Dim co As ChartObject 31 | For Each co In Sheets("LoanAmor").ChartObjects 32 | co.Delete 33 | Next 34 | 'cealr inputs table 35 | Range("B4:B9").ClearContents 36 | 37 | '================================================================================ 38 | 39 | 40 | Dim lastrow As Integer 41 | Dim Num As Integer 42 | Dim dateCode, Frequency As String 43 | Dim intRate As Double 44 | 45 | 'variables intRate, loanAmnt(Loan Amount) and loanLife) are entered by user 46 | 47 | '********************************************************************************* 48 | 'Input Robust Check and Print Parameters on Worksheet 49 | '********************************************************************************* 50 | 'check if there is no input 51 | If loanAmnt = "" Or anualIntRate = "" Or loanLife = "" Then 52 | MsgBox ("Sorry, there is no input in the userform") 53 | Exit Sub 54 | End If 55 | 56 | 'check principal is positive and the variant type 57 | If IsNumeric(loanAmnt) = False Or loanAmnt <= 0 Then 58 | MsgBox ("please enter a positive number for principal") 59 | Exit Sub 60 | End If 61 | 62 | 'check whether the type of interest rate is number or not 63 | If IsNumeric(anualIntRate) = False Then 64 | MsgBox ("Please enter a number of anual interest") 'interest can be either positive or negative 65 | Exit Sub 66 | End If 67 | 68 | 'check if loanLife is positive interger 69 | '!loanLife can't be a double when payment is annual 70 | '!but when payment is monthly, loanLife can be a double 71 | If PaymentFrequency = "Monthly" Then 72 | If IsNumeric(loanLife) = False Or loanLife <= 0 Then 73 | MsgBox ("please enter positive number of years for monthly payment or positive integer for annual payment") 74 | Exit Sub 75 | End If 76 | ElseIf IsNumeric(loanLife) = False Or loanLife <= 0 Then 'Annual payment situation 77 | MsgBox ("please enter positive number of years for monthly payment or positive integer for annual payment") 78 | Debug.Print TypeName(loanLife) 79 | Exit Sub 80 | ElseIf Int(loanLife) / loanLife <> 1 Then 'whether loanLife is integer 81 | MsgBox ("please enter positive number of years for monthly payment or positive integer for annual payment") 82 | Exit Sub 83 | End If 84 | 85 | 86 | 'Print Parameters on worksheet 87 | Cells(4, 2).Value = PaymentType 88 | If PaymentType = "End of Period" Then 89 | Cells(10, 2).Value = 0 90 | Else 91 | Cells(10, 2).Value = 1 92 | End If 'this cells(10,2).value is helpful when filing the pmt function, 0 denotes end of period and 93 | '1 denotes beg of period).I dont know why excel function if when logicaltest contains "string" 94 | 'in vba can not work in .formular1c1 format, so i have to use this redundant method 95 | 96 | Cells(5, 2).Value = loanLife 97 | Cells(6, 2).Value = loanAmnt 98 | Cells(7, 2).Value = PaymentFrequency 99 | Cells(8, 2).Value = anualIntRate / 100 100 | Range("B10").Value = numPerAfter 101 | Cells(9, 2).Formula = "=edate(today(),B10)" 'set the first date of payment due 102 | 103 | '--------------------------------------------------------------------------------- 104 | ' PART 1:Programming For Constant Payment Amortization 105 | 106 | '--------------------------------------------------------------------------------- 107 | startRow = 13 108 | 109 | 'According to monthly or annual amortization, use different intRate and due date of payment 110 | 111 | If PaymentFrequency = "Monthly" Then 112 | dateCode = "m" 113 | Num = 1 114 | intRate = anualIntRate / 1200 115 | Dim numPer As Integer ' numPer stands for total # of periods 116 | numPer = loanLife * 12 117 | 118 | Else 119 | dateCode = "yyyy" 120 | Num = 1 121 | intRate = anualIntRate / 100 122 | numPer = loanLife 123 | 124 | End If 125 | lastrow = startRow + numPer - 1 126 | 127 | 'Get Date Column 128 | StartDate = Range("$B$9").Value 129 | LDate = DateAdd(dateCode, 0, StartDate) 130 | If PaymentFrequency = "Monthly" And PaymentType = "End of Period" Then 131 | LDate = DateAdd(dateCode, Num, LDate) ' set due date of each payment 132 | Debug.Print "LDate", LDate 133 | ElseIf PaymentFrequency = "Annualy" And PaymentType = "End of Period" Then 134 | LDate = DateAdd(dateCode, Num, LDate) ' set due date of each payment 135 | 136 | End If 137 | 'output due date 138 | For i = 13 To lastrow 139 | Cells(i, 5).Value = LDate 140 | Cells(i, 16).Value = LDate 141 | LDate = DateAdd(dateCode, Num, LDate) 142 | Next i 143 | 144 | 145 | Dim pmnt As Double 'pmnt stands for payment each period 146 | Dim flag 'flag is a binary value to denote end or beg of period 147 | If PaymentType = "End of Period" Then 148 | flag = 0 149 | Else 150 | flag = 1 151 | End If 152 | Range("B11").Value = flag 153 | pmnt = WorksheetFunction.Pmt(intRate, numPer, -loanAmnt, , flag) 'flag = 0 for end of period, 1 for begin of period 154 | Debug.Print "flag", flag 155 | Debug.Print "pmnt", pmnt 156 | 157 | '************************************************************ 158 | ' using array to store the calculation result 159 | '************************************************************ 160 | Dim begBal(), endBal(), ipPay() 161 | ReDim begBal(numPer + 1), endBal(numPer), ipPay(1 To numPer, 1 To 2) 162 | 'begBal and endBal stand for beginning balance, end balance, respectively 163 | 'ipPay is 2 dimensional array used to store interest component and principal component each period 164 | iCol = 1 165 | pCol = 2 166 | 'initialize balance at the beginning of period 1 167 | begBal(1) = loanAmnt 168 | 169 | If PaymentType = "End of Period" Then 170 | 'Loop to calculate and store period-by-period data 171 | For i = 1 To numPer 172 | ipPay(i, iCol) = begBal(i) * intRate 173 | ipPay(i, pCol) = pmnt - ipPay(i, iCol) 174 | endBal(i) = begBal(i) - ipPay(i, pCol) 175 | begBal(i + 1) = endBal(i) 176 | Next i 177 | Else ' payment type is beg of period 178 | ipPay(1, iCol) = 0 'initial payment for interest 179 | ipPay(1, pCol) = pmnt - ipPay(1, iCol) 'initial payment for principal 180 | endBal(1) = begBal(1) - ipPay(1, pCol) 181 | begBal(2) = endBal(1) 182 | 183 | For i = 2 To numPer 184 | ipPay(i, iCol) = begBal(i) * intRate 185 | ipPay(i, pCol) = pmnt - ipPay(i, iCol) 186 | endBal(i) = begBal(i) - ipPay(i, pCol) 187 | begBal(i + 1) = endBal(i) 188 | Next i 189 | End If 190 | '************************************************************ 191 | ' Output data to worksheet 192 | '************************************************************ 193 | Range("F4").Value = numPer 'output number of periods 194 | Range("F5").Value = intRate 'output interest rate monthly or annualy depending on the situation 195 | RowIndex = 12 196 | For i = 1 To numPer 197 | Cells(RowIndex + i, 4).Value = i 198 | Cells(RowIndex + i, 6).Value = begBal(i) 199 | 'Cells(rowIndex + i, 7).Value = pmnt 200 | Cells(RowIndex + i, 7).FormulaR1C1 = "=pmt(r5c6,r4c6,-r6c2,,r11c2)" 201 | Cells(RowIndex + i, 8).Value = ipPay(i, iCol) 202 | Cells(RowIndex + i, 9).Value = ipPay(i, pCol) 203 | Cells(RowIndex + i, 10).Value = endBal(i) 204 | Cells(RowIndex + i, 11).Value = ipPay(i, iCol) / pmnt 'interest percentage in payment each period 205 | Cells(RowIndex + i, 12).Value = ipPay(i, pCol) / pmnt 'principal percentage in payment each period 206 | Next i 207 | 'Check the answer using function Ppmt & Ipmt 208 | For i = 1 To numPer 209 | Cells(RowIndex + i, 13).FormulaR1C1 = "=ppmt(r5c6,rc[-9],r4c6,-r6c2,,r11c2)+ipmt(r5c6,rc[-9],r4c6,-r6c2,,r11c2)" 210 | Next i 211 | 212 | '--------------------------------------------------------------------------------- 213 | ' PART 2:Programming For Straight-line Amortization 214 | '*just repeat the first part 1 of constant payment amortization, only modify a few parameters 215 | '--------------------------------------------------------------------------------- 216 | Dim pmnt4Int(), pmnt4Prin(), payment() 217 | ReDim begBal(numPer + 1), endBal(numPer), pmnt4Int(numPer), pmnt4Prin(numPer), payment(numPer) 218 | begBal(1) = loanAmnt 219 | If PaymentType = "End of Period" Then 220 | For i = 1 To numPer 221 | pmnt4Prin(i) = loanAmnt / numPer 222 | pmnt4Int(i) = begBal(i) * intRate 223 | endBal(i) = begBal(i) - pmnt4Prin(i) 224 | begBal(i + 1) = endBal(i) 225 | payment(i) = pmnt4Int(i) + pmnt4Prin(i) 226 | Next i 227 | Else ' payment type is beg of period 228 | pmnt4Prin(1) = loanAmnt / numPer 229 | pmnt4Int(1) = 0 230 | endBal(1) = begBal(1) - pmnt4Prin(1) 231 | begBal(2) = endBal(1) 232 | payment(1) = pmnt4Int(1) + pmnt4Prin(1) 233 | 234 | For i = 2 To numPer 235 | pmnt4Prin(i) = loanAmnt / numPer 236 | pmnt4Int(i) = begBal(i) * intRate 237 | endBal(i) = begBal(i) - pmnt4Prin(i) 238 | begBal(i + 1) = endBal(i) 239 | payment(i) = pmnt4Int(i) + pmnt4Prin(i) 240 | Next i 241 | End If 242 | 243 | 'output date to worksheet 244 | RowIndex = 12 245 | For i = 1 To numPer 246 | Cells(RowIndex + i, 15).Value = i 247 | Cells(RowIndex + i, 17).Value = begBal(i) 248 | Cells(RowIndex + i, 18).Value = payment(i) 249 | Cells(RowIndex + i, 19).Value = pmnt4Int(i) 250 | Cells(RowIndex + i, 20).Value = pmnt4Prin(i) 251 | Cells(RowIndex + i, 21).Value = endBal(i) 252 | Cells(RowIndex + i, 22).Value = pmnt4Int(i) / payment(i) 'interest percentage 253 | Cells(RowIndex + i, 23).Value = pmnt4Prin(i) / payment(i) 'principal percentage 254 | Cells(RowIndex + i, 16).Select 255 | Next i 256 | 257 | '************************************************************ 258 | ' OutPut all other related statistic data 259 | '************************************************************ 260 | Range("H6").Value = Application.Sum(Range("S13:S" & lastrow)) 'Total Interest Expense 261 | Range("H7").Value = Application.Sum(Range("R13:R" & lastrow)) 'Total Payments 262 | 263 | Range("F6").Value = Application.Sum(Range("H13:H" & lastrow)) 'Total Interest Expense for constant payment 264 | Range("F7").Value = Application.Sum(Range("G13:G" & lastrow)) 'Total Payments for constant payment 265 | 266 | '************************************************************ 267 | ' Format OutPut Data in Table 268 | '************************************************************ 269 | 270 | Application.Union(Range("F13:J" & lastrow), Range("Q13:U" & lastrow)).Select 271 | Selection.NumberFormat = "$#,##0.00" 272 | Application.Union(Range("K13:L" & lastrow), Range("V13:W" & lastrow)).Select 273 | Selection.NumberFormat = "0.00%" 274 | 275 | Application.Union(Range("D13:M" & lastrow), Range("O13:W" & lastrow)).Select 276 | With Selection.Interior 277 | .ThemeColor = xlThemeColorAccent6 278 | .PatternColorIndex = xlAutomatic 279 | .TintAndShade = 0.799981688894314 280 | End With 281 | Range("D13:D" & lastrow).HorizontalAlignment = xlCenter 282 | Range("O13:O" & lastrow).HorizontalAlignment = xlCenter 283 | '--------------------------------------------------------------------------------- 284 | ' PART 3:Data Visulazation -- Plotting Charts 285 | 286 | '--------------------------------------------------------------------------------- 287 | '************************************************************ 288 | ' Data Visulazation for Constant Payment Amortization 289 | '************************************************************ 290 | Dim rng As Range 291 | Dim cht As Object 292 | 'plotting component of each period (ie.beg.balance,payment, int, prin ,endBalance) changing over time 293 | For i = 1 To 5 294 | 'Your data range for the chart 295 | Set rng = ActiveSheet.Range("F13:F" & lastrow).Offset(0, i - 1) 296 | 'Create a chart 297 | Set cht = ActiveSheet.ChartObjects.Add( _ 298 | Left:=Range("N13").Left, _ 299 | Width:=450, _ 300 | Top:=Range("N13").Top, _ 301 | Height:=250) 302 | 'Give chart some data 303 | cht.Chart.SetSourceData Source:=rng 304 | 'Determine the chart type 305 | cht.Chart.ChartType = xlXYScatter 'xlXYScatterLinesNoMarkers 306 | With cht 307 | .Chart.HasTitle = True 308 | .Chart.ChartTitle.Text = _ 309 | "The Change of " & Range("F11").Offset(0, i - 1) & Range("F12").Offset(0, i - 1) 310 | .Chart.HasLegend = False 311 | End With 312 | Next i 313 | 314 | 'plotting payment for int versus payment for principal each period 315 | 'AddChart2 Method 316 | Set rng = ActiveSheet.Range("H13:I" & lastrow) 317 | rng.Select 318 | ActiveSheet.Shapes.AddChart2(297, xlColumnStacked, Left:=Range("N13").Left, _ 319 | Top:=Range("N13").Top, Width:=450, Height:=250).Select 320 | ActiveChart.SetSourceData Source:=rng 321 | ActiveChart.ChartTitle.Text = "Payment for Interest and Principal over Periods " 322 | ActiveChart.SeriesCollection(1).Name = "Interest Component" 323 | ActiveChart.SeriesCollection(2).Name = "Principal Repaid" 324 | 'plotting change of proportion for interest and prinipal over time 325 | Set rng = ActiveSheet.Range("K13:L" & lastrow) 326 | 'Create a chart 327 | Set cht = ActiveSheet.ChartObjects.Add( _ 328 | Left:=Range("N13").Left, _ 329 | Width:=450, _ 330 | Top:=Range("N13").Top, _ 331 | Height:=250) 332 | With cht.Chart 333 | .ChartType = xlLine 334 | .SetSourceData Source:=rng 335 | .HasTitle = True 336 | .ChartTitle.Text = "Change of Interest and Principal Proportion" 337 | .SeriesCollection(1).Name = "Int" 338 | .SeriesCollection(2).Name = "Prin" 339 | End With 340 | 341 | '************************************************************ 342 | ' Data Visulazation for straight-line Amortization 343 | '************************************************************ 344 | 345 | 'plotting component of each period (ie.beg.balance,payment, int, prin ,endBalance) changing over time 346 | For i = 1 To 5 347 | Set rng = ActiveSheet.Range("Q13:Q" & lastrow).Offset(0, i - 1) 348 | 349 | Set cht = ActiveSheet.ChartObjects.Add( _ 350 | Left:=Range("N13").Left, _ 351 | Width:=450, _ 352 | Top:=Range("N13").Top, _ 353 | Height:=250) 354 | 355 | cht.Chart.SetSourceData Source:=rng 356 | 357 | cht.Chart.ChartType = xlXYScatter 358 | With cht 359 | .Chart.HasTitle = True 360 | .Chart.HasLegend = False 361 | .Chart.ChartTitle.Text = _ 362 | "The Change of " & Range("Q11").Offset(0, i - 1) & Range("Q12").Offset(0, i - 1) 363 | End With 364 | Next i 365 | 366 | Set rng = ActiveSheet.Range("S13:T" & lastrow) 367 | rng.Select 368 | ActiveSheet.Shapes.AddChart2(297, xlColumnStacked, Left:=Range("N13").Left, _ 369 | Top:=Range("N13").Top, Width:=450, Height:=250).Select 370 | ActiveChart.SetSourceData Source:=rng 371 | ActiveChart.ChartTitle.Text = "Payment for Interest and Principal Over Periods " 372 | ActiveChart.SeriesCollection(1).Name = "Interest Component" 373 | ActiveChart.SeriesCollection(2).Name = "Principal Repaid" 374 | Set rng = ActiveSheet.Range("V13:W" & lastrow) 375 | Set cht = ActiveSheet.ChartObjects.Add( _ 376 | Left:=Range("N13").Left, _ 377 | Width:=450, _ 378 | Top:=Range("N13").Top, _ 379 | Height:=250) 380 | With cht.Chart 381 | .ChartType = xlLine 382 | .SetSourceData Source:=rng 383 | .HasTitle = True 384 | .ChartTitle.Text = "Change of Interest and Principal Proportion" 385 | .SeriesCollection(1).Name = "Int" 386 | .SeriesCollection(2).Name = "Prin" 387 | End With 388 | 389 | '************************************************************ 390 | ' formatting all charts 391 | '************************************************************ 392 | Dim chtObj As ChartObject 393 | For Each chtObj In ActiveSheet.ChartObjects 394 | If chtObj.Chart.HasLegend = True Then 395 | With chtObj.Chart.Legend.Font 396 | .Name = "Calibri" 397 | .Size = 11 398 | End With 399 | End If 400 | 401 | With chtObj.Chart.ChartTitle 402 | .Top = 0 403 | .Left = 0 404 | .Font.Name = "Times New Roman" 405 | .Font.Size = 13 406 | '.Font.Bold = False 407 | End With 408 | 409 | With chtObj.Chart.Axes(Type:=xlCategory, AxisGroup:=xlPrimary) 410 | .HasTitle = True 411 | .AxisTitle.Text = "Periods" 412 | .AxisTitle.Font.Name = "Times New Roman" 413 | .AxisTitle.Font.Size = 12 414 | .AxisTitle.Font.Bold = False 415 | .HasMajorGridlines = False 416 | .HasMinorGridlines = False 417 | End With 418 | 419 | With chtObj.Chart.Axes(Type:=xlValue, AxisGroup:=xlPrimary) 420 | .HasMajorGridlines = False 421 | .HasMinorGridlines = False 422 | End With 423 | 424 | chtObj.Visible = False 'hide all charts 425 | Next 426 | 427 | 428 | Range("K4").Select 429 | 430 | '************************************************************ 431 | ' option button for amortization type 432 | '************************************************************ 433 | If CPoption.Value = True Then 434 | Range("O13:W1048576").clear 435 | ElseIf SLoption.Value = True Then 436 | Range("D13:M1048576").clear 437 | End If 438 | 439 | End Sub 440 | 441 | 442 | '--------------------------------------------------------------------------------- 443 | ' PART 4:Displaying Dynamic Charts Using Userform 444 | ' please refer to the code in Userform of "DisplayingDynamicCharts" 445 | '--------------------------------------------------------------------------------- 446 | 447 | 448 | Private Sub PlotChart_Click() 449 | 450 | DisplayingDynamicCharts.Show 451 | 452 | End Sub 453 | 454 | '--------------------------------------------------------------------------------- 455 | ' PART 5:Supplements 456 | ' 457 | '--------------------------------------------------------------------------------- 458 | 'Create New Tables in new worksheets 459 | Private Sub CreateNewTable_Click() 460 | Worksheets("LoanAmor").Activate 461 | Dim rename As String 462 | rename = Application.InputBox(prompt:="Please Name the New Worksheet") 463 | Sheets.Add(After:=Sheets("LoanAmor")).Name = rename 464 | 465 | If PaymentFrequency = "Monthly" Then 466 | Dim numPer As Integer 467 | numPer = loanLife * 12 468 | Else 469 | numPer = loanLife 470 | End If 471 | lastrow = 13 + numPer - 1 472 | 473 | Sheets("LoanAmor").Select 474 | If CPoption.Value = True Then 475 | Range("D10:L" & lastrow).Copy 476 | Sheets(rename).Select 477 | Range("A1").Select 478 | ActiveSheet.Paste 479 | ElseIf SLoption.Value = True Then 480 | Range("O10:W" & lastrow).Copy 481 | Sheets(rename).Select 482 | Range("A1").Select 483 | ActiveSheet.Paste 484 | Else 485 | Range("D10:W" & lastrow).Copy 486 | Sheets(rename).Select 487 | Range("A1").Select 488 | ActiveSheet.Paste 489 | End If 490 | 491 | End Sub 492 | 493 | Private Sub ScrollBar_Change() 494 | AmortizationCaculator.anualIntRate = AmortizationCaculator.ScrollBar.Value 495 | End Sub 496 | 497 | 498 | 499 | ############### 500 | Displaying charts codes 501 | ############### 502 | Public chartNum As Integer 503 | 504 | Sub getmychart() 505 | 506 | Dim currentchart As Chart 507 | Dim fname As String 508 | Dim ws As Worksheet 509 | Set ws = Sheets("LoanAmor") 510 | Set currentchart = ws.ChartObjects(chartNum).Chart 511 | currentchart.Parent.Width = 320 512 | currentchart.Parent.Height = 230 513 | 514 | fname = ThisWorkbook.Path & "\temp.gif" 515 | currentchart.Export Filename:=fname, FilterName:="GIF" 516 | Image1.Picture = LoadPicture(fname) 517 | 518 | Set currentchart = ws.ChartObjects(chartNum + 7).Chart 519 | currentchart.Parent.Width = 320 520 | currentchart.Parent.Height = 230 521 | 522 | fname = ThisWorkbook.Path & "\temp.gif" 523 | currentchart.Export Filename:=fname, FilterName:="GIF" 524 | Image2.Picture = LoadPicture(fname) 525 | 526 | End Sub 527 | 528 | Private Sub cmdExit_Click() 529 | Unload Me 530 | End Sub 531 | 532 | Private Sub cmdNext_Click() 533 | If chartNum = 7 Then 534 | chartNum = 1 535 | Else 536 | chartNum = chartNum + 1 537 | End If 538 | 539 | Call getmychart 540 | End Sub 541 | 542 | Private Sub cmdPrevious_Click() 543 | If chartNum = 1 Then 544 | chartNum = 7 545 | Else 546 | chartNum = chartNum - 1 547 | End If 548 | Call getmychart 549 | End Sub 550 | 551 | 552 | Private Sub UserForm_Initialize() 553 | chartNum = 1 554 | Call getmychart 555 | End Sub 556 | 557 | --------------------------------------------------------------------------------