Merge duplicate rows and sum column for each name

[pdjm12]

Hi

The data I'm trying to consolidate has this structure. I found pieces of code around the forum but i just can't make it work, is there a way using VBA or a formula I can do this?

Make this:

<tbody>
[TD="class: xl63"]A[/TD]
[TD="class: xl63"]B[/TD]

[TD="class: xl63"][/TD]
[TD="class: xl63"]John[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]apple[/TD]

[TD="class: xl63"]2[/TD]
[TD="class: xl63"]apple[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]orange[/TD]

[TD="class: xl63"][/TD]
[TD="class: xl63"]Peter[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]Lemon[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]Orange[/TD]

[TD="class: xl63"]2[/TD]
[TD="class: xl63"]Lemon[/TD]

[TD="class: xl63"]3[/TD]
[TD="class: xl63"]Orange[/TD]

[TD="class: xl63"][/TD]
[TD="class: xl63"]Richard[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]orange[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]lemon[/TD]

[TD="class: xl63"]2[/TD]
[TD="class: xl63"]apple[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]apple[/TD]

[TD="class: xl63"][/TD]
[TD="class: xl63"]James[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]lemon[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]coconut[/TD]

[TD="class: xl63"]2[/TD]
[TD="class: xl63"]apple[/TD]

[TD="class: xl63"]2[/TD]
[TD="class: xl63"]coconut[/TD]

[TD="class: xl63"]1[/TD]
[TD="class: xl63"]lemon[/TD]

</tbody>

...

become this:

[TABLE="width: 128"]
<tbody>[TR]
[TD="class: xl65, width: 64"]A[/TD]
[TD="class: xl65, width: 64"]B[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]John[/TD]
[/TR]
[TR]
[TD="class: xl65"]3[/TD]
[TD="class: xl65"]apple[/TD]
[/TR]
[TR]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]orange[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]Peter[/TD]
[/TR]
[TR]
[TD="class: xl65"]3[/TD]
[TD="class: xl65"]Lemon[/TD]
[/TR]
[TR]
[TD="class: xl65"]4[/TD]
[TD="class: xl65"]Orange[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]Richard[/TD]
[/TR]
[TR]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]orange[/TD]
[/TR]
[TR]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]lemon[/TD]
[/TR]
[TR]
[TD="class: xl65"]3[/TD]
[TD="class: xl65"]apple[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]James[/TD]
[/TR]
[TR]
[TD="class: xl65"]2[/TD]
[TD="class: xl65"]lemon[/TD]
[/TR]
[TR]
[TD="class: xl65"]3[/TD]
[TD="class: xl65"]coconut[/TD]
[/TR]
[TR]
[TD="class: xl65"]2[/TD]
[TD="class: xl65"]apple[/TD]
[/TR]
</tbody>[/TABLE]

Thank you

 

[MickG]

Try this:-
NB:- This code will replace the data in columns "A & B".

[COLOR="Navy"]Sub[/COLOR] MG22Jun18
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Ray(), c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]Set[/COLOR] Rng = Range("A:A").SpecialCells(xlCellTypeConstants)
ReDim Ray(1 To Lst, 1 To 2)

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
        [COLOR="Navy"]If[/COLOR] Not .Exists(R.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
            .Add R.Offset(, 1).Value, R.Value
        [COLOR="Navy"]Else[/COLOR]
            .Item(R.Offset(, 1).Value) = .Item(R.Offset(, 1).Value) + R.Value
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
    
    c = c + 1
    Ray(c, 2) = Dn(1).Offset(-1, 1)
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
            c = c + 1
            Ray(c, 2) = k: Ray(c, 1) = .Item(k)
        [COLOR="Navy"]Next[/COLOR] k
   .RemoveAll
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
Range("A:B").ClearContents
Range("A1").Resize(c, 2).Value = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[pdjm12]

Thank you so much! Your code works great

 

[MickG]

You're welcome