Sum amounts same header entire sheet.

[Serafin54]

Hello,

I've been trying a way to either sum values with identical headers whether in VBA or pivot. The issue with pivot is since i need the headers for the columns, I get a 2,3,4 etc after the name and still retain multiple columns i still need to sum later so kinda gave up on that run.

What I've been doing is sorting left to right based on name, inserting a column, summing, filling down then copy/paste/delete old data. Since this is a lot of manual work as I can have upwards of 100 columns and a lot of repeating headers due to the way our software converts the reports I am looking for possibly a vba solution.

The biggest issue is, the names can and do change as do the positions and row count so it would need to be either a range or the entire sheet.

Is this even a possibility? The first image is an example of the before and second is the after showing Apples summed in one column.

Cheers!

 

[lrobbo314]

You can do it with Power Query.

Book One.xlsx
	A	B	C	D	E	F	G	H	I	J
1	Name	Apples	Bananas	Apples2	Carrots		Name	Apples	Bananas	Carrots
2	Joe	1	2	3	4		Joe	4	2	4
3	John	5	6	7	8		John	12	6	8
4	Mike	9	10	11	12		Mike	20	10	12
5	Terry	13	14	15	16		Terry	28	14	16
Sheet9

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Unpivot = Table.UnpivotOtherColumns(Source, {"Name"}, "Attribute", "Value"),
    StripNum = Table.TransformColumns(Unpivot,{{"Attribute",each Text.Select(_,{"A".."z"})}}),
    Group = Table.Group(StripNum, {"Name", "Attribute"}, {{"Total", each List.Sum([Value]), type number}}),
    Index = Table.AddIndexColumn(Group, "Index", 0, 1, Int64.Type),
    IntDiv = Table.TransformColumns(Index,{{"Index", each Number.IntegerDivide(_,3)}}),
    Pivot = Table.Pivot(IntDiv, List.Distinct(IntDiv[Attribute]), "Attribute", "Total"),
    RemoveIndex = Table.RemoveColumns(Pivot,{"Index"})
in
    RemoveIndex

 

[Serafin54]

Thank you. I am not familiar with Power Query (guess i am about to be). I was hoping there was a vba that could accomplish this but if this is the avenue, so be it. Thank you.

 

[alansidman]

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.

 

[Serafin54]

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.

Thank you. I appreciate the links to get me started.

 

[lrobbo314]

Here is a way using VBA.

Book5 (version 1).xlsb
	A	B	C	D	E	F	G	H	I	J
1	Name	Apples	Bananas	Apples	Carrots		Name	Apples	Bananas	Carrots
2	Joe	1	2	3	4		Joe	4	2	4
3	John	5	6	7	8		John	12	6	8
4	Mike	9	10	11	12		Mike	20	10	12
5	Terry	13	14	15	16		Terry	28	14	16
Sheet1

Sub VBAWAY()
Dim r As Range:         Set r = Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim v As Variant

For i = 1 To UBound(AR, 2)
    If Not SD.exists(AR(1, i)) Then
        SD.Add AR(1, i), Application.Index(AR, 0, i)
    Else
        v = SD(AR(1, i))
        For j = 2 To UBound(v)
            v(j, 1) = v(j, 1) + AR(j, i)
        Next j
        SD(AR(1, i)) = v
    End If
Next i

For col = 0 To SD.Count - 1
    Cells(1, 7 + col).Resize(5, 1).Value = SD.items()(col)
Next col
End Sub

 

[Serafin54]

Here is a way using VBA.

Book5 (version 1).xlsb
	A	B	C	D	E	F	G	H	I	J
1	Name	Apples	Bananas	Apples	Carrots		Name	Apples	Bananas	Carrots
2	Joe	1	2	3	4		Joe	4	2	4
3	John	5	6	7	8		John	12	6	8
4	Mike	9	10	11	12		Mike	20	10	12
5	Terry	13	14	15	16		Terry	28	14	16
Sheet1

Sub VBAWAY()
Dim r As Range:         Set r = Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim v As Variant

For i = 1 To UBound(AR, 2)
    If Not SD.exists(AR(1, i)) Then
        SD.Add AR(1, i), Application.Index(AR, 0, i)
    Else
        v = SD(AR(1, i))
        For j = 2 To UBound(v)
            v(j, 1) = v(j, 1) + AR(j, i)
        Next j
        SD(AR(1, i)) = v
    End If
Next i

For col = 0 To SD.Count - 1
    Cells(1, 7 + col).Resize(5, 1).Value = SD.items()(col)
Next col
End Sub

How would i change this to be to include all rows and columns? Sometimes there could be 15 columns other times 50 or so as well as well as up to 10000 rows depending on drops.

But the sample base i tested works perfectly. Thank you!!!!

 

[lrobbo314]

You would change this line.

Dim r As Range:         Set r = Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)

Right now it is only looking at columns A:E. Just change the 'E' part of that to whatever column you want it to go out to. It already will go to however many rows you have.

 

[lrobbo314]

I guess you would need to change this line too.

Cells(1, 7 + col).Resize(5, 1).Value = SD.items()(col)

The 7 refers to the column where it will start outputting the results. You would want to make sure that is far enough out to not overwrite your original data.

I could amend the code for you to clear out the original data and just leave you with the new results if you want.

 

[lrobbo314]

Here it is. This accommodates however many rows and columns you want, and it will just clear out the original table and leave you with the results like below.

Before:

Book5 (version 1).xlsb
	A	B	C	D	E	F	G
1	Name	Apples	Bananas	Apples	Carrots	Cucumbers	Carrots
2	Joe	1	2	3	4	5	6
3	John	5	6	7	8	9	10
4	Mike	9	10	11	12	13	14
5	Terry	13	14	15	16	17	18
6	Steve	19	20	21	22	23	24
Sheet1

After:

Book5 (version 1).xlsb
	A	B	C	D	E	F	G
1	Name	Apples	Bananas	Carrots	Cucumbers
2	Joe	4	2	10	5
3	John	12	6	18	9
4	Mike	20	10	26	13
5	Terry	28	14	34	17
6	Steve	40	20	46	23
Sheet1

Sub VBAWAY()
Dim r As Range:         Set r = Range("A1").CurrentRegion
Dim rc As Integer:      rc = r.Rows.Count
Dim AR() As Variant:    AR = r.Value2
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim v As Variant

For i = 1 To UBound(AR, 2)
    If Not SD.exists(AR(1, i)) Then
        SD.Add AR(1, i), Application.Index(AR, 0, i)
    Else
        v = SD(AR(1, i))
        For j = 2 To UBound(v)
            v(j, 1) = v(j, 1) + AR(j, i)
        Next j
        SD(AR(1, i)) = v
    End If
Next i

r.ClearContents

For col = 0 To SD.Count - 1
    Cells(1, 1 + col).Resize(rc, 1).Value = SD.items()(col)
Next col
End Sub