Do Until Loop, Sum then Write

[JJT]

I have an Access database with about 2,000 records. Each record is made up of 1 text name field and 5 numeric fields.
name | #1 pencils | #2 pencils..........

Each name field may be repeated several times, which is ok.

I need to be able to loop through the table, for each like name field,total the like numeric values and put the result into a new table with just one occurance of the name with the total of the numeric values.

Any suggestions ?

Thanks.

 

[ntp]

I sugest using the aggregate function DSUM to calculate the totals for each specific name record. The following procedure when run will create a new table with one record for each group of records in your original table.
This code should do exactlty what you require.
Private Sub CreateNewtable()
Dim dbs As Database
Dim tblDef As TableDef
Dim tblDefNew As TableDef
Dim rsttblDef As Recordset
Dim rsttblDefNew As Recordset
Dim fld As Field
Dim idx0 As Integer
Dim previous, current As String
Dim strSQL As String

' create the new table
Set dbs = CurrentDb
Set tblDef = dbs.TableDefs("table1")
Set tblDefNew = dbs.CreateTableDef("NewTable1_" & Month(Now()) & Day(Now()) & Year(Now()))

With tblDefNew
.Fields.Append .CreateField("Name", dbText)
For idx0 = 1 To 5
.Fields.Append .CreateField("Number" & idx0, dbInteger)
Next idx0
End With
dbs.TableDefs.Append tblDefNew

Set rsttblDefNew = tblDefNew.OpenRecordset
strSQL = "SELECT Name, Number1, number2, number3, number4, number5 " _
& "FROM table1 ORDER BY Name;"
Set rsttblDef = dbs.OpenRecordset(strSQL)
rsttblDef.MoveFirst
previous = ""
current = rsttblDef!Name
While rsttblDef.EOF = False
If current <> previous Then
With rsttblDefNew
.AddNew
!Name = rsttblDef!Name
!Number1 = DSum("[Number1]", "table1", "[Name] = '" & rsttblDef!Name & "'")
!Number2 = DSum("[Number2]", "table1", "[Name] = '" & rsttblDef!Name & "'")
!Number3 = DSum("[Number3]", "table1", "[Name] = '" & rsttblDef!Name & "'")
!Number4 = DSum("[Number4]", "table1", "[Name] = '" & rsttblDef!Name & "'")
!Number5 = DSum("[Number5]", "table1", "[Name] = '" & rsttblDef!Name & "'")
.Update
End With
End If
rsttblDef.MoveNext
If rsttblDef.EOF = False Then
previous = current
current = rsttblDef!Name
End If
Wend

rsttblDef.Close
rsttblDefNew.Close
dbs.Close
Set rsttblDef = Nothing
Set rsttblDefNew = Nothing
Set dbs = Nothing
End Sub