RunningSum

danielc

Registered User.
Local time
Today, 08:18
Joined
Jul 6, 2005
Messages
13
Hi,

I'm a newbie with VBA.
I have a query sort asc by id and date

ID / TRANS / DATE
Z1 / 2500 / 01.07.06
Z1 / -300 / 02.07.06
Z1 / -450 / 03.07.06
Z1 / 225 / 03.07.06
Z2 / 325 / 01.07.06
Z2 / -226 / 01.07.06
Z2 / -100 / 02.07.06
........................

I want a function to make a sum for each code by day, beginning from the previous day result. My result should look like:

ID / STK / DATE
Z1 / 2500 / 01.07.06
Z1 / 2200 / 02.07.06
Z1 / 1975 / 03.07.06
Z2 / 99 / 01.07.06
Z2 / 0 / 02.07.06

Here it is my try, but doesen't show results for days with more than one TRANS:
Function d()
DoCmd.SetWarnings False
Dim stc As Integer
Dim cod As String
Dim codl As String
Dim DATA1 As Date
Dim DATA2 As Date

Set db = CurrentDb
Set rs = db.OpenRecordset("q4")
stc = rs.Fields("TRANS")
rs.MoveFirst

Do Until rs.EOF
DATA1 = rs.Fields("DATE")
stc = rs.Fields("TRANS")
codl = rs.Fields("ID")
If codl = cod Then
If (strResult + stc) > 0 Then
strResult = strResult + stc
Else
strResult = 0

End If

Else
DATA2 = rs.Fields("DATE")
strResult = stc

End If
cod = codl
Dim csql As String
If DATA1 = DATA2 Then
DATA2 = rs.Fields("DATE")
rs.MoveNext
Else
rs.MoveNext
DATA2 = rs.Fields("DATE")
If DATA1 <> DATA2 Then
csql = "INSERT INTO resulttable VALUES ('" & codl & "', '" & strResult & "', '" & DATA1 & "')"
DoCmd.RunSQL (csql)
rs.MovePrevious
DATA2 = rs.Fields("DATE")
rs.MoveNext
Else
rs.MoveNext
End If
End If

Loop

End Function


Thanks in advance for your help.

Daniel
 
I've figured out. Here is the code:

Function d()
DoCmd.SetWarnings False
Dim stc As Double
Dim cod As String
Dim codl As String
Dim DATA1 As Date
Dim DATA2 As Date

Set db = CurrentDb
Set rs = db.OpenRecordset("q4")
stc = rs.Fields("TRANS")
rs.MoveFirst

Do Until rs.EOF
DATA1 = rs.Fields("DATE")
codl = rs.Fields("cod")
stc = rs.Fields("TRANS")

If codl = cod Then
If (StrResult + stc) > 0 Then
StrResult = StrResult + stc
Else
StrResult = 0

End If

Else
StrResult = stc

End If
cod = codl
Dim csql As String

DATA1 = rs.Fields("DATE")
rs.MoveNext
DATA2 = rs.Fields("DATE")
If DATA1 <> DATA2 Then
csql = "INSERT INTO RESULTTABLE VALUES ('" & codl & "', '" & StrResult & "', '" & DATA1 & "')"
DoCmd.RunSQL (csql)
rs.MovePrevious
DATA2 = rs.Fields("DATE")
rs.MoveNext
Else
rs.MovePrevious
DATA2 = rs.Fields("DATE")
rs.MoveNext
End If


Loop

End Function
 

Users who are viewing this thread

Back
Top Bottom