Consolidate and Sum Values from a Variable Data Set

[VanceLiving]

[TABLE="class: grid, width: 500, align: right"]
<tbody>[TR]
[TD]Current:
[/TD]
[TD]Jan
[/TD]
[TD]Feb
[/TD]
[/TR]
[TR]
[TD]627
[/TD]
[TD]10
[/TD]
[TD]10
[/TD]
[/TR]
[TR]
[TD]635
[/TD]
[TD]25
[/TD]
[TD]25
[/TD]
[/TR]
[TR]
[TD]635
[/TD]
[TD]25
[/TD]
[TD]25
[/TD]
[/TR]
[TR]
[TD]832
[/TD]
[TD]5
[/TD]
[TD]5
[/TD]
[/TR]
</tbody>[/TABLE]
Hi,

I've been working to build/find some code to basically consolidate data based on an existing data set (see Current table - mine is actually for 12 months). I'm trying to sum totals based on matching values in column A. Also, the data range varies so I'm hoping to find a dynamic solution.

So end results would be:

Jan Feb
627 10 10
635 50 50
832 5 5

Thank you for you consideration! Already wasted a day trying to solve this puzzle.

 

[MickG]

Try this:-
NB:This code will alter your data

[COLOR="Navy"]Sub[/COLOR] MG14May50
[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("A1").CurrentRegion
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Columns(1).Cells
  [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
      .Add Dn.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)
    [COLOR="Navy"]For[/COLOR] n = 1 To Rng.Columns.Count - 1
        .Item(Dn.Value).Offset(, n).Value = .Item(Dn.Value).Offset(, n).Value + Dn.Offset(, n).Value
    [COLOR="Navy"]Next[/COLOR] n
  [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

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[VanceLiving]

Thanks, Mick! That works but I'm still having a problem with using it for my purposes. My true data set actually has several blank cells in the first column like below (my apologies for the choppiness of the table - can't insert a table). Could you let me know how to modify your code to accommodate those empty cells? I really appreciate your help!

Jan Feb
Working Working
BUDGET BUDGET
627 10 10
635 25 25
635 25 25
832 5 5

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG15May17
[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"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
[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 IsEmpty(Dn.Value) [COLOR="Navy"]Then[/COLOR]
  [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
      .Add Dn.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)
    [COLOR="Navy"]For[/COLOR] n = 1 To Lst - 1
        .Item(Dn.Value).Offset(, n).Value = .Item(Dn.Value).Offset(, n).Value + Dn.Offset(, n).Value
    [COLOR="Navy"]Next[/COLOR] n
  [COLOR="Navy"]End[/COLOR] If
 [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

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[VanceLiving]

Super - thanks again, Mick!!

 

[MickG]

You're welcome