|
Question : Loan Calculator
|
|
Trying to find out if anyone has come across a Loan Calculator add-in. If so where can I take a look at it? Otherwise, I'll have to create one on my own, and I don't know how to get started...Thanks in advance for any help.
|
|
|
Answer : Loan Calculator
|
|
Here is the code. Now remember, this was writting in DAO - Access 97. I have not updated it to ADO yet, but it still works.
Just make sure you have the reference "Microsoft DAO 3.6 Object Library" set.
First create a Form - Unbound - "frm_Payment_Schedule"
The field names are in the code.
Then a table "tbl_Schedule".
The field names are in the code.
Two queries - "qdel_Schedule" and "qsel_Schedule"
Subform - "fsub_Schedule"
Create Command Buttons to run the code.
*******************************************************
Option Compare Database
Option Explicit
Function Calculate_With_Date()
Dim dblInterestRate As Double
Dim intPaymentPeriod As Integer
Dim intNumPeriods As Integer
Dim dblPresentValue As Double
Dim dblTotalPaid As Double
Dim dblPaidInterest As Double
Dim stDocName As String
Dim datStartDate As Date
Dim dblPayment As Double
Dim dblAmtInterest As Double
Dim dblPrinciple As Double
Dim dblYTDInterest As Double
Dim dblYTDPrinciple As Double
Dim rst_Calculate As Recordset
Dim db As Database
Dim intCounter As Integer
Dim dat_Payment_Month As Date
Set db = CurrentDb
If IsNull(Forms!frm_Payment_Schedule!dat_Start_Month) Then
Call Calculate_No_Date
Exit Function
End If
If IsNull(Forms!frm_Payment_Schedule!cur_Loan_Amount) Then
MsgBox "You Must Enter The Loan Amount", vbOKOnly, "Loan Amount Not Entered"
Forms!frm_Payment_Schedule!cur_Loan_Amount.SetFocus
Exit Function
End If
If IsNull(Forms!frm_Payment_Schedule!per_Interest_Rate) Then
MsgBox "You Must Enter The Interest Rate", vbOKOnly, "Interest Rate Not Entered"
Forms!frm_Payment_Schedule!per_Interest_Rate.SetFocus
Exit Function
End If
If IsNull(Forms!frm_Payment_Schedule!num_Loan_Lenght) Then
MsgBox "You Must Enter The Lenght Of The Loan", vbOKOnly, "Loan Length Not Entered"
Forms!frm_Payment_Schedule!num_Loan_Lenght.SetFocus
Exit Function
End If
datStartDate = Forms!frm_Payment_Schedule!dat_Start_Month
datStartDate = DateAdd("m", 1, [datStartDate])
DoCmd.SetWarnings False
stDocName = "qdel_Schedule"
DoCmd.OpenQuery stDocName, acNormal, acEdit
dblPresentValue = Forms!frm_Payment_Schedule!cur_Loan_Amount
dblInterestRate = Forms!frm_Payment_Schedule!per_Interest_Rate
dblInterestRate = dblInterestRate / 100
intNumPeriods = Forms!frm_Payment_Schedule!num_Loan_Lenght
intCounter = 0
intPaymentPeriod = 1
dblYTDInterest = 0
dblYTDPrinciple = 0
Set rst_Calculate = db.OpenRecordset("tbl_Schedule", DB_OPEN_DYNASET)
Do Until intCounter = intNumPeriods
dblAmtInterest = IPmt(dblInterestRate / 12, intPaymentPeriod, intNumPeriods, -dblPresentValue)
dblAmtInterest = Format(dblAmtInterest, "###,###,##0.00")
dblPrinciple = PPmt(dblInterestRate / 12, intPaymentPeriod, intNumPeriods, -dblPresentValue)
dblPrinciple = Format(dblPrinciple, "###,###,##0.00")
dblPayment = dblAmtInterest + dblPrinciple
dblPayment = Format(dblPayment, "###,###,##0.00")
dblTotalPaid = dblPayment * intNumPeriods
dblTotalPaid = Format(dblTotalPaid, "###,###,##0.00")
dblPaidInterest = dblTotalPaid - dblPresentValue
dblPaidInterest = Format(dblPaidInterest, "###,###,##0.00")
dblYTDPrinciple = dblYTDPrinciple + dblPrinciple
dblYTDInterest = dblYTDInterest + dblAmtInterest
Forms!frm_Payment_Schedule!cur_Interest_Paid = dblPaidInterest
Forms!frm_Payment_Schedule!cur_Monthly_Payment = dblPayment
Forms!frm_Payment_Schedule!cur_Total_Payback = dblTotalPaid
With rst_Calculate
.AddNew
!num_Payment_Number = intPaymentPeriod
!cur_Interest_Amount = dblAmtInterest
!cur_Principle_Amount = dblPrinciple
!cur_Interest_YTD = dblYTDInterest
!cur_Principle_YTD = dblYTDPrinciple
!cur_Total_Paid_YTD = (dblYTDInterest + dblYTDPrinciple)
!dat_Payment_Month = datStartDate
.Update
End With
intCounter = intCounter + 1
intPaymentPeriod = intPaymentPeriod + 1
datStartDate = DateAdd("m", 1, [datStartDate])
Loop
Forms!frm_Payment_Schedule.Refresh
DoCmd.SetWarnings True
'MsgBox "Complete"
End Function
Function ClearStuff()
Forms!frm_Payment_Schedule!cur_Interest_Paid = Null
Forms!frm_Payment_Schedule!cur_Monthly_Payment = Null
Forms!frm_Payment_Schedule!cur_Total_Payback = Null
Forms!frm_Payment_Schedule!cur_Loan_Amount = Null
Forms!frm_Payment_Schedule!per_Interest_Rate = Null
Forms!frm_Payment_Schedule!num_Loan_Lenght = Null
Forms!frm_Payment_Schedule!dat_Start_Month = Null
End Function
Function Calculate_No_Date()
Dim dblInterestRate As Double
Dim intPaymentPeriod As Integer
Dim intNumPeriods As Integer
Dim dblPresentValue As Double
Dim dblTotalPaid As Double
Dim dblPaidInterest As Double
Dim stDocName As String
Dim datStartDate As Date
Dim dblPayment As Double
Dim dblAmtInterest As Double
Dim dblPrinciple As Double
Dim dblYTDInterest As Double
Dim dblYTDPrinciple As Double
Dim rst_Calculate As Recordset
Dim db As Database
Dim intCounter As Integer
Dim dat_Payment_Month As Date
Set db = CurrentDb
If IsNull(Forms!frm_Payment_Schedule!cur_Loan_Amount) Then
MsgBox "You Must Enter The Loan Amount", vbOKOnly, "Loan Amount Not Entered"
Forms!frm_Payment_Schedule!cur_Loan_Amount.SetFocus
Exit Function
End If
If IsNull(Forms!frm_Payment_Schedule!per_Interest_Rate) Then
MsgBox "You Must Enter The Interest Rate", vbOKOnly, "Interest Rate Not Entered"
Forms!frm_Payment_Schedule!per_Interest_Rate.SetFocus
Exit Function
End If
If IsNull(Forms!frm_Payment_Schedule!num_Loan_Lenght) Then
MsgBox "You Must Enter The Lenght Of The Loan", vbOKOnly, "Loan Length Not Entered"
Forms!frm_Payment_Schedule!num_Loan_Lenght.SetFocus
Exit Function
End If
DoCmd.SetWarnings False
stDocName = "qdel_Schedule"
DoCmd.OpenQuery stDocName, acNormal, acEdit
dblPresentValue = Forms!frm_Payment_Schedule!cur_Loan_Amount
dblInterestRate = Forms!frm_Payment_Schedule!per_Interest_Rate
dblInterestRate = dblInterestRate / 100
intNumPeriods = Forms!frm_Payment_Schedule!num_Loan_Lenght
intCounter = 0
intPaymentPeriod = 1
dblYTDInterest = 0
dblYTDPrinciple = 0
Set rst_Calculate = db.OpenRecordset("tbl_Schedule", DB_OPEN_DYNASET)
Do Until intCounter = intNumPeriods
dblAmtInterest = IPmt(dblInterestRate / 12, intPaymentPeriod, intNumPeriods, -dblPresentValue)
dblAmtInterest = Format(dblAmtInterest, "###,###,##0.00")
dblPrinciple = PPmt(dblInterestRate / 12, intPaymentPeriod, intNumPeriods, -dblPresentValue)
dblPrinciple = Format(dblPrinciple, "###,###,##0.00")
dblPayment = dblAmtInterest + dblPrinciple
dblPayment = Format(dblPayment, "###,###,##0.00")
dblTotalPaid = dblPayment * intNumPeriods
dblTotalPaid = Format(dblTotalPaid, "###,###,##0.00")
dblPaidInterest = dblTotalPaid - dblPresentValue
dblPaidInterest = Format(dblPaidInterest, "###,###,##0.00")
dblYTDPrinciple = dblYTDPrinciple + dblPrinciple
dblYTDInterest = dblYTDInterest + dblAmtInterest
Forms!frm_Payment_Schedule!cur_Interest_Paid = dblPaidInterest
Forms!frm_Payment_Schedule!cur_Monthly_Payment = dblPayment
Forms!frm_Payment_Schedule!cur_Total_Payback = dblTotalPaid
With rst_Calculate
.AddNew
!num_Payment_Number = intPaymentPeriod
!cur_Interest_Amount = dblAmtInterest
!cur_Principle_Amount = dblPrinciple
!cur_Interest_YTD = dblYTDInterest
!cur_Principle_YTD = dblYTDPrinciple
!cur_Total_Paid_YTD = (dblYTDInterest + dblYTDPrinciple)
.Update
End With
intCounter = intCounter + 1
intPaymentPeriod = intPaymentPeriod + 1
Loop
Forms!frm_Payment_Schedule.Refresh
DoCmd.SetWarnings True
'MsgBox "Complete"
End Function
Thanks
WonHop
|
|
|
|
|
