This line looks a little funny:
x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
maybe just once <vbg
x = Cells(Rows.Count, 1).End(xlUp).Row

And just as another alternative...
Excel has a couple of built in worksheet functions that would be nice. There's
=sumif() to add up numbers based on a criteria--and =countif() that counts items
based on a criteria.

You can use those and build a range to delete and still work from the top down.

Option Explicit
Sub testme02()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim delRng As Range
Dim myRng As Range

With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

Set myRng = .Range(.Cells(FirstRow, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))

'do the first row
.Cells(FirstRow, "B").Value _
= Application.SumIf(myRng, .Cells(FirstRow, "A").Value, _
myRng.Offset(0, 1))

For iRow = 2 To LastRow
If Application.CountIf(.Range(.Cells(FirstRow, "A"), _
.Cells(iRow - 1, "A")), .Cells(iRow, "A")) 0 Then
'it's a duplicate of a previous row, so get ready to delete it
If delRng Is Nothing Then
Set delRng = .Cells(iRow, "A")
Else
Set delRng = Union(.Cells(iRow, "A"), delRng)
End If
Else
.Cells(iRow, "B").Value _
= Application.SumIf(myRng, .Cells(iRow, "A").Value, _
myRng.Offset(0, 1))
End If

Next iRow
End With

If delRng Is Nothing Then
'do nothing
Else
delRng.EntireRow.Delete
End If

End Sub

Just another way to approach the problem. (Although I like the pivottable
best.)

Another non-macro way would be to use those equivalent formulas in a couple of
helper cells. Then apply Data|filter|autofilter to delete the rows that are the
duplicates (after converting to values).

Helmut Weber wrote:

Hi,

this one looks best, so far.

And I wonder, why one has to be told,
what he told himself others a dozen times. ;-)

Sometimes life becomes lots easier if you start at the bottom
of the data and work your way up. Then you don't have to worry
about keeping track of what row you're on (when a row is deleted).

Sub Test1112()
Dim r1 As Long ' row 1
Dim r2 As Long ' row 2, which is identical once to row 1
Dim v As Long ' a value to be added
Dim s1 As String ' a name
Dim s2 As String ' a name, too, which is identical once to s1
Dim x As Long ' last row
x = Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
For r1 = x To 1 Step -1
For r2 = x To 1 Step -1
s1 = Cells(r1, 1).Value
s2 = Cells(r2, 1).Value
v = Cells(r1, 2).Value
If r1 < r2 And s1 = s2 Then
v = v + Cells(r2, 2).Value
Cells(r1, 2).Value = v
Rows(r2).Delete
End If
Next
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA (not Excel!)

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

--

Dave Peterson