How's Everyone . . . . .
See faq701-5268 for [blue]Running Sum in Queries[/blue].
I've been asked and researched a great many requests for a [blue]running sum in a form[/blue]. Research has come up with a DSum method (which is slow) and other methods which are dependant on a key field, specifically sorted in ascending order (this is a severe limitation). Finally ran into a routine that is faster than DSum and independant of sorting. I don't know who to give the credit too for the foundation of the base routine, but you can find it in [purple]Microsofts Knowledge Base[/purple] http://support.microsoft.com/default.aspx?scid=kb;en-us;210338. What I present here is a modification, plus additions to the routine, to make it [blue]global to any form/subform on which you wish to perform a running sum[/blue].
Advantages of the routine:
1) Faster than DSum.
2) Independent of Sorting.
3) Performs running sum for any form/subform.
The routine requires [blue]Microsoft DAO 3.6 Object Library[/blue]. To check/install the library, click [blue]
References[/blue] on the [blue]
Tools[/blue] menu in the Visual Basic Editor, and make sure that the [blue]Microsoft DAO 3.6 Object Library[/blue] check box is selected.
Now . . . . create a new module in the module window. Name the module [blue]modRunSum[/blue]. Add the following to the declarations section if it doesn't already exist:
Code:
[blue]Option Explicit[/blue]
Next . . . . copy/paste the following function to the same module, ([purple]
this is the global running sum routine[/purple]):
Code:
[blue]Public Function frmRunSum(frm As Form, pkName As String, sumName As String)
Dim rst As DAO.Recordset, fld As DAO.Field, subTotal
Set rst = frm.RecordsetClone
Set fld = rst(sumName)
[green]'Set starting point.[/green]
rst.FindFirst "[" & pkName & "] = " & frm(pkName)
[green]'Running Sum (subTotal) for each record group occurs here.
'After the starting point is set, we sum backwards to record 1.[/green]
If Not rst.BOF Then
Do Until rst.BOF
subTotal = subTotal + Nz(fld, 0)
rst.MovePrevious
Loop
Else
subTotal = 0
End If
frmRunSum = subTotal
Set fld = Nothing
Set rst = Nothing
End Function[/blue]
Next . . . . for each form where you require a runnung sum, add the following code to the corresponding forms code module. [blue]This code must be in form module[/blue] as were passing '[purple]Me[/purple]' as the current form object. The programmer must supply all items in [purple]
purple[/purple].
Code:
[blue]Private Function SubSum()
[green]'*************************************************************
'* pkName - Existing [b]unique fieldname[/b] (usually primarykey) *
'* sumName - Name of the field to runsum *
'*************************************************************[/green]
If Trim(Me![purple][b]pkName[/b][/purple] & "") <> "" Then [green]'Skip New Record![/green]
SubSum = frmRunSum(Me, "[purple][b]pkName[/b][/purple]", "[purple][b]sumName[/b][/purple]")
End If
End Function[/blue]
Almost there . . . . .
In the details section of the form, add an unbound textbox. Set the [blue]Control Source[/blue] to:
Code:
[purple]=[b]SubSum[/b]()[/purple]
Finally, to see updates on the fly, in the [blue]AfterUpdate[/blue] event of the field to runsum copy/paste the following:
Code:
[blue] DoEvents
Me.Recalc[/blue]
Thats it! . . . . give it a whirl and let me know if anyone has any problems.
Any input on this schema, good or bad, is most certainly welcome.
[blue]Cheers All! . . .[/blue]
![[thumbsup2] [thumbsup2] [thumbsup2]](/data/assets/smilies/thumbsup2.gif)