Sub totals

[arye9]

Hi,
I made a program which calculate sums let say money in the bank.
The form is like that

date sum sub Total
1/1/00 100 100
2/1/00 -30 70
3/1/00 5 75
etc.

In the report I have no problem to show the sub total but in the form I had to use VB procedure which works OK but I have tried it with 10,000 records and it took long time.
Is there any code which I can put in the Sub Total TextBox to calculate it faster?

(Access 2000)

Thanks Arye

 

[inimeg]

How did you code this?

I've been struggling to get this functionality without success. Could you possibly share you function with me?

I will appreciate it.

Regards,

 

[inimeg]

How did you code this?

I've been struggling to get this functionality without success. Could you possibly share you function with me?

I will appreciate it.

Regards,

 

[Rich]

What do you call a long time?

 

[arye9]

Hi

Private Sub CmdCalcTotal_Click()
'1. Forgive my English
'2. I have a bug err 2105 If you solve it please note me
'3. About the speed, in the beggining I made addition calculation for Day,Month and Year
' but It was useless for me
'4. I had to change few names (textBox etc. which (Uncleverly) are written in Hebrew Fomts
' So I hope I have not mistakes
'5. I hope you like it
On Error GoTo er
'Sorting by date
OrderByOn = True
OrderBy = "Date1"

Application.Echo 0
AllowAdditions = -1
'I wrote Requery and Refresh and I dont sure that is important
Requery
Refresh
Dim ctl As Control, Schum
Dim Dbs As Database
Dim recS As Recordset
Set Dbs = CurrentDb
Set recS = Dbs.OpenRecordset(Name_Of_Table)
DoCmd.GoToRecord , , acFirst
Dim a As Integer
For a = 0 To recS.RecordCount
'S_sum is the text box which holds the money of the record
'SubTotal is the text box which show the sub total
Schum = Schum + S_Sum
SubTotal = Schum
DoCmd.GoToRecord , , acNext
Next
DoCmd.GoToRecord , , acFirst
ex:
DoCmd.GoToRecord , , acFirst
ex1:
Application.Echo -1
AllowAdditions = 0

Exit Sub
er:
If Err = 2105 Then Resume ex
' I add this Err 2105 because I have a bug, The prog tries to use additonal acNext (you see it)
If Err = 2427 Then
MsgBox "", vbInformation, "Empty Data"
Resume ex1
End If
MsgBox Err '.Description
Resume ex1
End Sub
I hope it helps you

 

[Rich]

Here is Microsoft's own running sum function, it works well provided you have a sequential ID field, it will allow you to sort out of sequence ID's say by date
Function RunSum(F As Form, KeyName As String, KeyValue, _
FieldToSum As String)
'***********************************************************

' FUNCTION: RunSum()
' PURPOSE: Compute a running sum on a form.
' PARAMETERS:
' F - The form containing the previous value to
' retrieve.
' KeyName - The name of the form's unique key field.
' KeyValue - The current record's key value.
' FieldToSum - The name of the field in the previous
' record containing the value to retrieve.
' RETURNS: A running sum of the field FieldToSum.

' EXAMPLE: =RunSum(Form,"ID",[ID],"Amount")
'***********************************************************
Dim RS As Recordset
Dim Result

On Error GoTo Err_RunSum

' Get the form Recordset.
Set RS = F.RecordsetClone

' Find the current record.
Select Case RS.Fields(KeyName).Type
' Find using numeric data type key value?
Case DB_INTEGER, DB_LONG, DB_CURRENCY, _
DB_SINGLE, DB_DOUBLE, DB_BYTE

RS.FindFirst "[" & KeyName & "] = " & KeyValue
' Find using date data type key value?
Case DB_DATE
RS.FindFirst "[" & KeyName & "] = #" & KeyValue & "#"
' Find using text data type key value?
Case DB_TEXT
RS.FindFirst "[" & KeyName & "] = '" & KeyValue & "'"
Case Else
MsgBox "ERROR: Invalid key field data type!"
GoTo Bye_RunSum
End Select

' Compute the running sum.
Do Until RS.BOF
Result = Result + RS(FieldToSum)

' Move to the previous record.
RS.MovePrevious
Loop

Bye_RunSum:
RunSum = Result
Exit Function

Err_RunSum:
Resume Bye_RunSum

End Function
HTH