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

Serafin54

New Member
Joined
Apr 11, 2014
Messages
31
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
Now that there is a thing of beauty. I love how it combines in place and not append. This is a masterpiece! Thank you. Can't wait to still dive into that power query tutorial as well.
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,097
Office Version
  1. 365
Platform
  1. Windows
Glad you dig it. Thanks for the feedback.

───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂
 

Watch MrExcel Video

Forum statistics

Threads
1,127,597
Messages
5,625,729
Members
416,130
Latest member
galgozzi

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