Budgeting and Control.
The local Charity Organization for Children allocates funds for disbursement under various categories to eligible individuals or entities. The Accounts Section oversees these disbursement activities and ensures that the total payments made under each category do not exceed the allocated budget.
We have been asked to develop a computerized system to monitor the payment activity and verify that the cumulative value of all payments for a given category remains within the approved budget limit.
Below is a sample screen used for recording payment details:
As shown in the screen above, a Budget Amount of $10,000 has been allocated to the Poor Children’s Education Fund. This amount is distributed to eligible individuals or deserving institutions after careful evaluation of their cases. The payment records are entered in the datasheet subform below. Both the Main Form and the Subform are linked through the Category Code, an AutoNumber field in the main table.
When a new record is entered in the subform with a payment amount, the program calculates the total of all payment records, including the current entry, and compares it against the budget amount on the main form. If the total payment amount exceeds the allocated budget, an error message is displayed. In such cases, the program automatically deducts the excess amount from the current payment value.
After this adjustment, the focus is set to the Amount field, allowing the User to review the correction and take appropriate action if necessary.
In this example, users are not restricted from modifying the Budget Amount. However, the field can be locked immediately after a new main record is created for the budget value. If authorized modifications are required at a later stage, special access rights can be granted to designated Users through Microsoft Access Security features. For the time being, let us keep aside the security aspect; let us take a closer look at the design and implementation of the datasheet subform and the associated procedures.
An image of the Payment Record Sub-Form Data Sheet Design View is given below:
A TextBox with an Active Record not yet saved.
We created a Text Box in the Subform Footer Section with an expression to calculate the total of all payment records for the current category, excluding the current new record. This happens because the Sum() function does not include the new record value until it is saved in the table.
For example, the Text Box expression:
=Sum([Amt])
will correctly total all saved records. Although this control is not visible in Datasheet View, it can still be referenced in VBA procedures. (For additional techniques with Datasheet Forms, see the article Event Trapping and Summary on Datasheet.)
To include the value of the current (unsaved) record in the total, we can read it directly from the field (Me![Amt]) and add it to the result of the Sum() function. This gives us the Total of all disbursement records, including the current entry.
We can then compare this calculated total against the Budget Amount on the main form before accepting the new record. If the total exceeds the budget, the program can alert the user. This ensures that no payment entry pushes the cumulative disbursement beyond the allocated amount.
The Sub-Form Module Code.
The VBA Program Code written in 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 SubPerforming Validation Checks.
During data entry in the Payment Subform, if the cumulative value of all payment records reaches the allocated Budget Amount, the form will prevent adding any more payment records. However, existing payment records may still be opened and edited.
Similarly, when any Budget Category record becomes current on the Main Form, the program checks whether the total of its related payment records already equals the budgeted amount. If this condition is met, the Payment Subform is locked against new entries, but existing payment records remain editable.
The following VBA procedure, written in the Main Form’s module, enforces this rule and ensures that users cannot enter payment records once the budget is fully utilized:
Main Form Module Code.
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
Demo Database Download.
Click the following link to download a Demonstration Database with the above Code.
Download Demo BudgetDemo.zip
