Roll up string/sum from multiple roll when criteria match

[achantak]

Hi,
Anyone could help me to roll up the data when there's only one key of ID and distribute to many (One to many)
One ID no. has only one title, but has many CCC, R, C,T as below table

The data I extract from the server becomes like this

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID no[/TD]
[TD]Title[/TD]
[TD]CCC[/TD]
[TD]R[/TD]
[TD]C[/TD]
[TD]T[/TD]
[/TR]
[TR]
[TD]SAQ1234[/TD]
[TD]AAA[/TD]
[TD]H22[/TD]
[TD]0.51[/TD]
[TD]0.7[/TD]
[TD]0.4[/TD]
[/TR]
[TR]
[TD]SAQ1234[/TD]
[TD]AAA[/TD]
[TD]C13[/TD]
[TD]0.49[/TD]
[TD]0.3[/TD]
[TD]0.4[/TD]
[/TR]
[TR]
[TD]SAQ1234[/TD]
[TD]AAA[/TD]
[TD]D13[/TD]
[TD]0.3[/TD]
[TD]0.3[/TD]
[TD]0.2[/TD]
[/TR]
[TR]
[TD]SAQ4321[/TD]
[TD]BBB[/TD]
[TD]H22[/TD]
[TD]0.1[/TD]
[TD]0.2[/TD]
[TD]0.8[/TD]
[/TR]
[TR]
[TD]SAQ4321[/TD]
[TD]BBB[/TD]
[TD]H24[/TD]
[TD]0.9[/TD]
[TD]0.8[/TD]
[TD]0.2[/TD]
[/TR]
[TR]
[TD]SAQ5478[/TD]
[TD]CCC[/TD]
[TD]C24[/TD]
[TD]0.1[/TD]
[TD]0.1[/TD]
[TD]0.1[/TD]
[/TR]
</tbody>[/TABLE]

What I need is... One ID has one Title, consolidate CCC R, C, T from multiple roll to one roll and delete the roll that has been consolidated.

ID, title and CCC are string, R,C,T are numeric with 2 decimal place.
Quantity of CCC would not over 10 in maximum.

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID no[/TD]
[TD]Title[/TD]
[TD]CCC[/TD]
[TD]R[/TD]
[TD]C[/TD]
[TD]T[/TD]
[/TR]
[TR]
[TD]SAQ1234[/TD]
[TD]AAA[/TD]
[TD]H22, C13, D13[/TD]
[TD]1.3[/TD]
[TD]1.3[/TD]
[TD]1.0[/TD]
[/TR]
[TR]
[TD]SAQ4321[/TD]
[TD]BBB[/TD]
[TD]H22, H24[/TD]
[TD]1.0[/TD]
[TD]1.0[/TD]
[TD]1.0[/TD]
[/TR]
[TR]
[TD]SAQ5478[/TD]
[TD]CCC[/TD]
[TD]C24[/TD]
[TD]0.1[/TD]
[TD]0.1[/TD]
[TD]0.1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Understand that Pivot table can do that, but VBA is appreciated.

Thank you so much.

achantak

 

[MickG]

Try this:-
Make backup of data as this code will modify your sheet data.

[COLOR="Navy"]Sub[/COLOR] MG15Sep20
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oCat    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] nRng    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    oCat = Dn & Dn.Offset(, 1)
        [COLOR="Navy"]If[/COLOR] Not .Exists(oCat) [COLOR="Navy"]Then[/COLOR]
            .Add oCat, Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] nRng = Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
            [COLOR="Navy"]End[/COLOR] If
            .Item(oCat).Offset(, 2).Value = .Item(oCat).Offset(, 2).Value & "," & Dn.Offset(, 2).Value
            .Item(oCat).Offset(, 3).Value = .Item(oCat).Offset(, 3).Value + Dn.Offset(, 3).Value
            .Item(oCat).Offset(, 4).Value = .Item(oCat).Offset(, 4).Value + Dn.Offset(, 4).Value
            .Item(oCat).Offset(, 5).Value = .Item(oCat).Offset(, 5).Value + Dn.Offset(, 5).Value
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[achantak]

That's Amazing!

Thank you so much

 

[MickG]

You're welcome
Regrds Mick