VBA - Consolidate data and Sum mulitiple ranges

[LucyJeanie]

Hi is there anyone who can help. I'm working on a project and I need a VBA Code to consolidate multiple rows based on a single column entry, then adding together the other columns. At the moment the data looks like this:

[TABLE="width: 840"]
<colgroup><col width="170" style="width: 128pt; mso-width-source: userset; mso-width-alt: 6217;"> <col width="140" style="width: 105pt; mso-width-source: userset; mso-width-alt: 5120;"> <col width="129" style="width: 97pt; mso-width-source: userset; mso-width-alt: 4717;"> <col width="104" style="width: 78pt; mso-width-source: userset; mso-width-alt: 3803;"> <col width="165" style="width: 124pt; mso-width-source: userset; mso-width-alt: 6034;"> <col width="78" style="width: 59pt; mso-width-source: userset; mso-width-alt: 2852;"> <col width="159" style="width: 119pt; mso-width-source: userset; mso-width-alt: 5814;"> <col width="173" style="width: 130pt; mso-width-source: userset; mso-width-alt: 6326;"> <tbody>[TR]
[TD="width: 170"]Financial Year & Period[/TD]
[TD="width: 140"]Incident Start Date[/TD]
[TD="width: 129"]Incident Number[/TD]
[TD="width: 104"]Period Count[/TD]
[TD="width: 165"]Incident Description[/TD]
[TD="width: 78"]Category[/TD]
[TD="width: 159"]WMT[/TD]
[TD="width: 173"]RDF[/TD]
[/TR]
[TR]
[TD]2018/19_P03[/TD]
[TD="align: right"]20/05/2018 10:30[/TD]
[TD]20705[/TD]
[TD="align: right"]1[/TD]
[TD]A87[/TD]
[TD]ABC[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]12[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]2018/19_P04[/TD]
[TD="bgcolor: transparent, align: right"]20/05/2018 10:30[/TD]
[TD="bgcolor: transparent"]20705[/TD]
[TD="bgcolor: transparent, align: right"]1[/TD]
[TD="bgcolor: transparent"]A87[/TD]
[TD="bgcolor: transparent"]ABC[/TD]
[TD="bgcolor: transparent, align: right"]46[/TD]
[TD="bgcolor: transparent, align: right"]52[/TD]
[/TR]
</tbody>[/TABLE]

and I need it to look like this:

[TABLE="width: 840"]
<colgroup><col width="170" style="width: 128pt; mso-width-source: userset; mso-width-alt: 6217;"> <col width="140" style="width: 105pt; mso-width-source: userset; mso-width-alt: 5120;"> <col width="129" style="width: 97pt; mso-width-source: userset; mso-width-alt: 4717;"> <col width="104" style="width: 78pt; mso-width-source: userset; mso-width-alt: 3803;"> <col width="165" style="width: 124pt; mso-width-source: userset; mso-width-alt: 6034;"> <col width="78" style="width: 59pt; mso-width-source: userset; mso-width-alt: 2852;"> <col width="159" style="width: 119pt; mso-width-source: userset; mso-width-alt: 5814;"> <col width="173" style="width: 130pt; mso-width-source: userset; mso-width-alt: 6326;"> <tbody>[TR]
[TD="width: 170"]Financial Year & Period[/TD]
[TD="width: 140"]Incident Start Date[/TD]
[TD="width: 129"]Incident Number[/TD]
[TD="width: 104"]Period Count[/TD]
[TD="width: 165"]Incident Description[/TD]
[TD="width: 78"]Category[/TD]
[TD="width: 159"]WMT[/TD]
[TD="width: 173"]RDF[/TD]
[/TR]
[TR]
[TD]2018/19_P03[/TD]
[TD="align: right"]20/05/2018 10:30[/TD]
[TD]20705
[/TD]
[TD="align: right"]2[/TD]
[TD]A87[/TD]
[TD]ABC[/TD]
[TD="align: right"]61[/TD]
[TD="align: right"]64[/TD]
[/TR]
</tbody>[/TABLE]

I need Period Count, RDF and WMT to be a total sum.

I've tried few variations on a code I have but it's not working properly.

PLEASE HELP!

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG14Feb09
[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] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Offset(, 2).Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Offset(, 2).Value, 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 Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
   .Item(Dn.Offset(, 2).Value).Offset(, 3).Value = _
   .Item(Dn.Offset(, 2).Value).Offset(, 3).Value + Dn.Offset(, 3).Value
   .Item(Dn.Offset(, 2).Value).Offset(, 6).Value = _
   .Item(Dn.Offset(, 2).Value).Offset(, 6).Value + Dn.Offset(, 6).Value
   .Item(Dn.Offset(, 2).Value).Offset(, 7).Value = _
   .Item(Dn.Offset(, 2).Value).Offset(, 7).Value + Dn.Offset(, 7).Value
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] With
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick