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'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