Sum amounts same header entire sheet.

Serafin54

New Member
Joined
Apr 11, 2014
Messages
31
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!
 

Attachments

  • Capture.JPG
    Capture.JPG
    16.3 KB · Views: 7
  • Capture.JPG
    Capture.JPG
    14.5 KB · Views: 7

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,103
Office Version
  1. 365
Platform
  1. Windows
You can do it with Power Query.

Book One.xlsx
ABCDEFGHIJ
1NameApplesBananasApples2CarrotsNameApplesBananasCarrots
2Joe1234Joe424
3John5678John1268
4Mike9101112Mike201012
5Terry13141516Terry281416
Sheet9


Power Query:
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

New Member
Joined
Apr 11, 2014
Messages
31
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

Well-known Member
Joined
Feb 26, 2007
Messages
6,165
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Apr 11, 2014
Messages
31

ADVERTISEMENT

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

Well-known Member
Joined
Jul 14, 2008
Messages
3,103
Office Version
  1. 365
Platform
  1. Windows
Here is a way using VBA.

Book5 (version 1).xlsb
ABCDEFGHIJ
1NameApplesBananasApplesCarrotsNameApplesBananasCarrots
2Joe1234Joe424
3John5678John1268
4Mike9101112Mike201012
5Terry13141516Terry281416
Sheet1


VBA Code:
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

New Member
Joined
Apr 11, 2014
Messages
31

ADVERTISEMENT

Here is a way using VBA.

Book5 (version 1).xlsb
ABCDEFGHIJ
1NameApplesBananasApplesCarrotsNameApplesBananasCarrots
2Joe1234Joe424
3John5678John1268
4Mike9101112Mike201012
5Terry13141516Terry281416
Sheet1


VBA Code:
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

Well-known Member
Joined
Jul 14, 2008
Messages
3,103
Office Version
  1. 365
Platform
  1. Windows
You would change this line.

VBA Code:
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

Well-known Member
Joined
Jul 14, 2008
Messages
3,103
Office Version
  1. 365
Platform
  1. Windows
I guess you would need to change this line too.

VBA Code:
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

Well-known Member
Joined
Jul 14, 2008
Messages
3,103
Office Version
  1. 365
Platform
  1. Windows
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
ABCDEFG
1NameApplesBananasApplesCarrotsCucumbersCarrots
2Joe123456
3John5678910
4Mike91011121314
5Terry131415161718
6Steve192021222324
Sheet1


After:
Book5 (version 1).xlsb
ABCDEFG
1NameApplesBananasCarrotsCucumbers
2Joe42105
3John126189
4Mike20102613
5Terry28143417
6Steve40204623
Sheet1


VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,753
Messages
5,626,665
Members
416,199
Latest member
Gautamsunil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top