Hi all,I'm working on a loan amortization schedule. I have created tblLoans, tblMembers, tblSchedules and tblPaymentsj also frmLoans, sbfSchedules & sbfPayments. I have also generated the schedule initally using DAO recordset.I want to add payments on a monthly basis with optional extra payments above the amortization amount if desired. I'm ok without the extra payments.
Challenge:
1. When I add extra, it reflects for the 1st record and 2nd record, then stops(should continue through and since extra payments will be made, then the number of payments should be reduced accordingly)
2. I also want a situation where on clicking the btnAddPayment, it checks the txtAmountPaid field, if there is a value(not zero), it moves to the next record and adds the payment, I also wants this check in sbfPayments(it is filled based on btnAddPayment in sbfSchedules)
3.Irrespective of the position of the cursor, I want it to fill the next record with a zero in both sbf's.Please find attached an image and the DB in MS Office 2000 format.
4.I noticed that the schedule table stores only the active member even if the member id is changed and schedule generated. Please how can I generate and store every generated schedule in the schedule table.
Code for sbfSchedules
Code:
Option Compare Database
Option Explicit
Public Sub btnAddPayment_Click()
On Error GoTo btnAddPayment_Click_Error
Dim dblAmountPaid As Double
Dim datPaidDate As Date
Dim RST As DAO.Recordset
Set RST = CurrentDb.OpenRecordset("Schedules", dbOpenDynaset)
dblAmountPaid = InputBox("What is the Payment Amount?", "Payment", Form_Loans.txtPMT)
datPaidDate = InputBox("What is the Payment Date?", "Date", Date)
Me!txtAmountPaid = dblAmountPaid
Form_Schedules.txtRegular = Form_Schedules.txtAmountDue
If Not Nz(dblAmountPaid) Then
Form_Payments.txtAmountPaid = dblAmountPaid
Form_Payments.txtPaidDate = datPaidDate
Form_Schedules.txtExtra = Form_Schedules.txtAmountPaid - Form_Schedules.txtRegular
Form_Schedules.txtEndingBalance = Round((Me.txtBeginningBalance) - _
(Me.txtAmountDue) - (Me.txtExtra), 2)
DoCmd.GoToRecord , , acNext
If Not RST.EOF Then
Form_Schedules.BeginningBalance = RST!EndingBalance
Me.txtEndingBalance = Me.txtBeginningBalance - Me.txtAmountDue - Me.txtExtra
End If
RST.Close
Set RST = Nothing
Me.Recalc
Me.Refresh
End If
btnAddPayment_Click_Exit:
Exit Sub
btnAddPayment_Click_Error:
Resume btnAddPayment_Click_Exit
End Sub
Private Sub btnRecalcSchedules_Click()
Me.Recalc
End Sub
Public Sub btnRepaymentSchedule_Click()
On Error GoTo btnRepaymentSchedule_Click_Error
Dim db As DAO.Database
Dim RS As DAO.Recordset
Set db = CurrentDb
Set RS = db.OpenRecordset("Schedules", dbOpenDynaset)
'Declare variables & Calculate Repayment Schedule
Dim intLoanID As Integer
Dim PMTN As Integer
Dim datDueDate As Date
Dim dblBeginningBalance As Double
Dim dblAmountDue As Double
Dim dblAmountPaid As Double
Dim dblRegularPayment As Double
Dim dblExtraPayment As Double
Dim dblEndingBalance As Double
Dim dblMonthlyRate As Double
Dim datPaidDate As Date
'Assign variables(from frmLoans)
If IsNull(Form_Loans!txtPMT) Then
MsgBox "Please calculate Monthly Payment to continue", vbOKOnly
Else
dblAmountDue = Round(Form_Loans.txtPMT, 2)
End If
dblBeginningBalance = Form_Loans!LoanAmount
dblMonthlyRate = Round(Form_Loans!InterestRate / Form_Loans!NumberOfPayments, 5)
datDueDate = Form_Loans!StartDate
'test for BOF & EOF
If RS.RecordCount <> 0 Then
MsgBox "Are You SURE? This will ERASE all your payment DATA,and create a new schedule!", _
vbYesNoCancel
While Not RS.EOF
RS.MoveFirst
RS.Delete
RS.MoveNext
Wend
'Loop for each month
For PMTN = 1 To Form_Loans!NumberOfPayments - 1
'Calculate the relevant figures (BeginBalance = Principal = oldbalance | EndBalance = newbalance)
'dblInterestPaid = Round(dblBeginningBalance * Form_Loans!txtInterest, 2)
'dblPrincipalPaid = Round(dblAmountDue - dblInterestPaid, 2)
dblEndingBalance = Round(dblBeginningBalance - dblAmountDue, 2)
'dblTotalInterest = dblTotalInterest + dblInterestPaid
dblExtraPayment = dblAmountPaid - dblRegularPayment
RS.AddNew
RS.Fields("LoanID") = Form_Loans.LoanID
RS.Fields("PaymentNumber") = PMTN
RS.Fields("DueDate") = datDueDate
datDueDate = DateAdd("m", 1, datDueDate)
RS.Fields("BeginningBalance") = dblBeginningBalance
RS.Fields("AmountDue") = dblAmountDue
RS.Fields("AmountPaid") = dblAmountPaid
RS.Fields("RegularPayment") = dblRegularPayment
RS.Fields("ExtraPayment") = dblExtraPayment
RS.Fields("EndingBalance") = dblEndingBalance
RS.Update
RS.Bookmark = RS.LastModified
dblBeginningBalance = dblEndingBalance
Next
'When PMTN = Form_Loans!NumberOfPayments, 'rs!EndingBalance <= rs!AmountDue, so this is_
'the last payment for this loan!
If PMTN = Form_Loans!NumberOfPayments Then
RS.AddNew
RS.Fields("LoanID") = Form_Loans.LoanID
RS.Fields("PaymentNumber") = PMTN
RS.Fields("DueDate") = datDueDate
datDueDate = DateAdd("m", 1, datDueDate)
RS.Fields("BeginningBalance") = dblBeginningBalance
RS.Fields("AmountDue") = dblAmountDue
RS.Fields("AmountPaid") = dblAmountPaid
RS.Fields("RegularPayment") = dblRegularPayment
RS.Fields("ExtraPayment") = dblExtraPayment
RS.Fields("EndingBalance") = dblEndingBalance
RS!EndingBalance = 0
RS.Update
RS.Bookmark = RS.LastModified
Me.Recalc
End If
End If
btnRepaymentSchedule_Click_Exit:
On Error Resume Next
On Error GoTo 0
RS.Close 'Close opened rs
Set RS = Nothing 'Deassigns rs & db
Set db = Nothing
Exit Sub
btnRepaymentSchedule_Click_Error:
'Error Handler here
Resume btnRepaymentSchedule_Click_Exit
End Sub
Please find attached an image and the DB in MS Office 2000 format.