Skip here is the code I have, works with names,billingnum,dates the same . Changed date in 2 records and not the correct output. Also the sum of qty didnt work correctly
test data
lastname firstname billingnum usedate c q
Test A 5555555555 051109 691030792 4
Test A 5555555555 051109 691033174 2
test A 5555555555 051109 691035033 1
Test A 5555555555 051109 691043726 1
Function CreateOfficeOutput()
Dim mydb As DAO.Database
Set mydb = CurrentDb()
Dim rs1 As DAO.Recordset
Set rs1 = mydb.OpenRecordset("ExportTable")
Dim rs2 As DAO.Recordset
Set rs2 = mydb.OpenRecordset("ExportRptTable")
Dim qSumA, qSumB As Integer
Dim RecCnt As Integer
RecCnt = 1
Dim strA1, strA2, strA3, strA4, strA5, strA6, strA7 As String
Dim strB1, strB2, strB3, strB4, strB5, strB6, strB7 As String
Dim strMemA, strMemB As String
rs1.MoveFirst
'initialize strings with first row of data
strA1 = rs1![lastname]
strA2 = rs1![firstname]
strA3 = rs1![billingnum]
strA4 = rs1![usedate]
strA5 = rs1![lastname] & rs1![firstname] & rs1![billingnum] & rs1![usedate]
strMemA = rs1![q] & "-" & rs1![c] & ", "
qSumA = rs1![q]
RecCnt = 1
'move to second record
rs1.MoveNext
strB1 = rs1![lastname]
strB2 = rs1![firstname]
strB3 = rs1![billingnum]
strB4 = rs1![usedate]
strB5 = rs1![lastname] & rs1![firstname] & rs1![billingnum] & rs1![usedate]
strMemB = rs1![q] & "-" & rs1![c] & ", "
qSumB = rs1![q]
Do While Not rs1.EOF
'load record data into bvariables
strB1 = rs1![lastname]
strB2 = rs1![firstname]
strB3 = rs1![billingnum]
strB4 = rs1![usedate]
strB5 = rs1![lastname] & rs1![firstname] & rs1![billingnum] & rs1![usedate]
strMemB = rs1![q] & "-" & rs1![c] & ", "
qSumB = rs1![q]
If StrComp(strA5, strB5, 1) = 0 Then 'test for change in either name billingnum or date
'If heading strings are identical
strMemA = strMemA & strMemB 'Concatenate q and c from rec two with rec 1
qSumA = qSumA + qSumB 'sum q for records
RecCnt = RecCnt + (1) 'increment record count
Else
'Heading strings are not equal
rs2.AddNew 'create a new record with data from A-strings
rs2![lastname] = strA1
rs2![firstname] = strA2
rs2![billingnum] = strA3
rs2![usedate] = strA4
rs2![chrgdata] = strMemA
rs2![numchrgs] = qSumA
rs2![numrecs] = RecCnt
rs2.Update
qSumA = ""
RecCnt = 1
End If
'move string data B to A prep for new record
strA5 = strB5
strA4 = strB4
strA3 = strB3
strA2 = strB2
strA1 = strB1
qSumA = qSumB
rs1.MoveNext
Loop
'This takes the last record and processes it
If rs1.EOF Then
If StrComp(strA5, strB5, 1) = 0 Then 'test for change in either name billingnum or date
'If heading strings are identical
strMemA = strMemA & strMemB 'Concatenate q and c from rec two with rec 1
qSumA = qSumA + qSumB 'sum q for records
RecCnt = RecCnt + (1) 'increment record count
rs2.AddNew
rs2![lastname] = strA1
rs2![firstname] = strA2
rs2![billingnum] = strA3
rs2![usedate] = strA4
rs2![chrgdata] = strMemA
rs2![numchrgs] = qSumA
rs2![numrecs] = RecCnt
rs2.Update
Else
'Heading strings are not equal
rs2.AddNew 'create a new record with data from A-strings
rs2![lastname] = strB1
rs2![billingnum] = strB3
rs2![usedate] = strB4
rs2![chrgdata] = strMemB
rs2![numchrgs] = qSumB
rs2![numrecs] = 1
rs2.Update
End If
End If
Close