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:

charitycontrol

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:

charitycontrol2

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.


Download Demo Database


Creating User Account with VBA

Microsoft Date/Time Picker Control

Form and Report Open Arguments

Indexing and sorting with VBA

Data Upload Controls