Combining matching values

[Robert87]

I´ve been trying to work this out for a while now, but I´m not getting anywhere.

I´ve got a list with several values and I want to combine a certain values if the other values match.

Since English isn´t my first language, I´m having a hard time explaining it. So I´ll just show what I mean.

I want to take this list:



Apples eaten
Color
Person


5
Green
John


2
Red
John


3
Green
Sarah


4
Green
Sarah


1
Red
Stephen


2
Red
Stephen





And make it into this:



Apples eaten
Color
Person


5
Green
John


2
Red
John


7
Green
Sarah


3
Red
Stephen





I would be very gretaful for help with this problem.

[mperrah]

not pretty but seems to work.
if you have names that match not in sequence adding will fail.
this puts the answer starting in Column E

Sub addLike()
Dim i, x, lr As Long

lr = Cells(Rows.Count, 3).End(xlUp).Row

For i = 2 To lr
If Cells(i, 3).Value = Cells(i + 1, 3) And _
Cells(i, 2).Value = Cells(i + 1, 2).Value Then
Cells(i, 5).Value = Cells(i, 1).Value + Cells(i + 1, 1).Value
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 7).Value = Cells(i, 3).Value
ElseIf Cells(i, 3).Value = Cells(i + 1, 3).Value And _
Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
Cells(i, 5).Value = Cells(i, 1).Value
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 7).Value = Cells(i, 3).Value
ElseIf Cells(i, 3).Value = Cells(i - 1, 3).Value And _
Cells(i, 2).Value <> Cells(i - 1, 2).Value Then
Cells(i, 5).Value = Cells(i, 1).Value
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 7).Value = Cells(i, 3).Value
End If
Next i

For x = lr To 2 Step -1
If Cells(x, 5).Value = "" Then
Cells(x, 5).Resize(1, 3).Select
Selection.Delete Shift:=xlUp
End If
Next x
End Sub

[mperrah]

this lists multiple listings out of sequence but does not sum, I'll fix that next

Sub addLike()
Dim i, x, lr As Long

lr = Cells(Rows.Count, 3).End(xlUp).Row

For i = 2 To lr
If Cells(i, 3).Value = Cells(i + 1, 3) And _
Cells(i, 2).Value = Cells(i + 1, 2).Value Then
Cells(i, 5).Value = Cells(i, 1).Value + Cells(i + 1, 1).Value
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 7).Value = Cells(i, 3).Value
ElseIf Cells(i, 3).Value = Cells(i + 1, 3).Value And _
Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
Cells(i, 5).Value = Cells(i, 1).Value
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 7).Value = Cells(i, 3).Value
ElseIf Cells(i, 3).Value = Cells(i - 1, 3).Value And _
Cells(i, 2).Value <> Cells(i - 1, 2).Value Then
Cells(i, 5).Value = Cells(i, 1).Value
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 7).Value = Cells(i, 3).Value
ElseIf Cells(i, 3).Value <> Cells(i - 1, 3).Value Then
Cells(i, 5).Value = Cells(i, 1).Value
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 7).Value = Cells(i, 3).Value
End If
Next i

For x = lr To 2 Step -1
If Cells(x, 5).Value = "" Then
Cells(x, 5).Resize(1, 3).Select
Selection.Delete Shift:=xlUp
End If
Next x
End Sub

[Yongle]

Pivot table would be my choice

13376

[Robert87]

*Edited*Nvm. I figured it out.

Pivot table seems like a good solution!
Thanks!

[mperrah]

Nice pivot table, but if you like:
Here is a vba option that puts the results at Column E


Sub vbax52577()
Dim countR, countG, lr, lrE, x As Long
Dim nameV As Variant
Dim nm

lr = Cells(Rows.Count, 1).End(xlUp).Row

Range("C2:C" & lr).Copy Destination:=Range("E1")
ActiveSheet.Range("$E$1:$E" & lr).RemoveDuplicates Columns:=1, Header:=xlNo

lrE = Cells(Rows.Count, 5).End(xlUp).Row
ReDim nameV(1 To lrE)
For x = 1 To lrE
nameV(x) = Cells(x, 5).Value
Next x

For nm = LBound(nameV) To UBound(nameV)
countG = 0
countR = 0
For i = 2 To lr
If nameV(nm) = Cells(i, 3) Then
If Cells(i, 2).Value = "Green" Then
countG = countG + Cells(i, 1).Value
ElseIf Cells(i, 2).Value = "Red" Then
countR = countR + Cells(i, 1).Value
End If
End If
Next i
Cells(nm, 6).Value = "Green"
Cells(nm, 7).Value = countG
Cells(nm, 8).Value = "Red"
Cells(nm, 9).Value = countR
Next nm
End Sub