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

ID no	Title	CCC	R	C	T
SAQ1234	AAA	H22	0.51	0.7	0.4
SAQ1234	AAA	C13	0.49	0.3	0.4
SAQ1234	AAA	D13	0.3	0.3	0.2
SAQ4321	BBB	H22	0.1	0.2	0.8
SAQ4321	BBB	H24	0.9	0.8	0.2
SAQ5478	CCC	C24	0.1	0.1	0.1

<tbody>
</tbody>

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.

ID no	Title	CCC	R	C	T
SAQ1234	AAA	H22, C13, D13	1.3	1.3	1.0
SAQ4321	BBB	H22, H24	1.0	1.0	1.0
SAQ5478	CCC	C24	0.1	0.1	0.1

<tbody>
</tbody>

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