Budgeting and Control
The local Charity Organization for Children allocate funds for disbursement to eligible individuals or entities under various categories. Accounts Section supervises the disbursement activities. It is part of the responsibility of Accounts Section to ensure that the total value of all payments of a particular category is not exceeding the allocated Amount.
We have been asked to write a program to monitor the payment activity and see that Total Value of all payments stays within or up to the limit of the budgeted amount. A sample screen, where payment details are recorded, is given below:
As you can see in the above screen; the Budget Amount $10,000/- is allocated to the Poor Children's Education Fund. This Amount will be given away to eligible individuals or deserving institutions. The amount given away after due consideration of the merit of their issues. The payment records are entered into the datasheet sub-form below. Both Forms are linked on the Category Code, which is an AutoNumber Field on the main Table.
When a new record is entered into the sub-form with the payment value; the total value of all payment records, including the new record, are calculated and cross checked with the budget amount on the main form. If the total of all payment values is not less than or equal to the budget amount then an error message is displayed. The excess value entered is deducted automatically from the current payment value to adjust it and make the total of all payment value equal to the budget amount.
The focus is set back to the amount field so that the User can take appropriate action.
In the above example the User is not prevented from making modifications to the Budget Amount. But, this field can be locked immediately after creating a new main record with a value. If authorized changes to these records are required at a later period then special access rights can be given to some category of authorized Users. But, this part involves Microsoft Access Security implementation. Leaving that part aside we will take a closer look at the Datasheet Sub-form design and programs, where we have implemented the above procedure.
An image of the Payment Record Sub-Form Datasheet Design View is given below:
We have created a Text Box at the Footer Section of the Form and written an expression to Sum() the Amount of all Payment records of the current Payment Category, except the current new record. The new record value will not appear in the result of the Sum() Function till the record is saved in the Table. Even though the Text Box that we have created with the expression =Sum(me![amt]) in the Footer Section of the Sub-Form, It is not visible in Datasheet view, but we can refer it in Programs. For more tricks with Datasheet Form read the Article: Event Trapping and Summary on Datasheet.
The current record value can be read directly from the form field (Me![Amt]) and add it to the result of the Sum() Function to get the Total Value of all records, including the record not yet saved to the Table. This result can be checked with the Budget control value before the new record value is accepted in the current record. If it is not acceptable then the User is alerted so that corrective action can be initiated.
The VBA Program Code written on the Sub-Form Module is given below:
Option Compare Database Option Explicit 'Gobal declarations Dim Disbursedtotal As Currency, BudgetAmount As Currency, BalanceAmt As Currency Dim errFlag As Boolean, oldvalue As Currency Private Sub Amt_GotFocus() 'Me!TAmt is Form Footer Total except the new record value Disbursedtotal = Nz(Me!TAMT, 0) BudgetAmount = Me.Parent!TotalAmount oldvalue = Me![Amt] End Sub Private Sub Amt_LostFocus() Dim current_amt As Currency, msg As String, button As Long On Error GoTo Amt_LostFocus_Err Me.Refresh 'add current record value to total and cross-check 'with main form amount, if the transactions exceed 'then trigger error and set the focus back to the 'field so that corrections can be done current_amt = Disbursedtotal + Nz(Me!Amt, 0) BalanceAmt = BudgetAmount - current_amt errFlag = False If BalanceAmt < 0 And oldvalue = 0 Then errFlag = True button = 1 GoSub DisplayMsg ElseIf oldvalue > 0 Then current_amt = (Disbursedtotal - oldvalue) + Nz(Me!Amt, 0) BalanceAmt = BudgetAmount - current_amt If BalanceAmt < 0 Then errFlag = True button = 1 GoSub DisplayMsg End If Else Me.Parent![Status] = 1 End If Amt_LostFocus_Exit: Exit Sub DisplayMsg: msg = "Total Approved Amt.: " & BudgetAmount & vbCr & vbCr & "Payments Total: " & current_amt & vbCr & vbCr & "Payment Exceeds by : " & Abs(BalanceAmt) MsgBox msg, vbOKOnly, "Amt_LostFocus()" Return Amt_LostFocus_Err: MsgBox Err.Description, , "Amt_LostFocus()" Resume Amt_LostFocus_Exit End Sub Private Sub Form_Current() Dim budget As Currency, payments As Currency On Error Resume Next budget = Me.Parent.TotalAmount.Value payments = Nz(Me![TAMT], 0) If payments = budget Then Me.AllowAdditions = False Else Me.AllowAdditions = True End If End Sub Private Sub Remarks_GotFocus() If errFlag Then errFlag = False Me![Amt] = Me![Amt] + BalanceAmt BalanceAmt = 0 Me.Parent![Status] = 2 Me.Amt.SetFocus End If End Sub
During data entry on the Payment Sub-Form, if the total of all payment value equals to the Budget Amount then the Form will not allow to add more payment records. Exiting Payment records can be edited.
When any of the Budget Record on the Main Form become Current it checks whether the total Value of its payments records equal to the Budget Value, if so the Payment Form is locked and will not allow to add more records. But, the existing payment records can be edited.
The following VBA Code on the Main Form Module keep track of the above activity on the Main Form:
Option Compare Database Private Sub cmdClose_Click() DoCmd.Close End Sub Private Sub Form_Load() DoCmd.Restore End Sub Private Sub Form_Current() Dim budget As Currency, payments As Currency Dim frm As Form On Error Resume Next Set frm = Me.Transactions.Form budget = Me!TotalAmount payments = Nz(frm![TAMT], 0) If payments = budget Then frm.AllowAdditions = False Else frm.AllowAdditions = True End If End Sub
Click the following link to download a Demonstration Database with the above Code.
Creating User Account with VBA