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!

 

[Serafin54]

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

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.

 

[lrobbo314]

Glad you dig it. Thanks for the feedback.

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