VBA for combining duplicate columns and sum the value in different cells

D

darrenliux

New Member
Joined
May 13, 2018
Messages
15
Hi
I'm looking for a VBA code to solve the problem below, the input will start in Cell I2. I'd really appreciate any help on this.
Raw input table:
[TABLE="width: 800"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[TD="align: center"]I[/TD]
[TD="align: center"]J[/TD]
[TD="align: center"]K[/TD]
[TD="align: center"]L[/TD]
[TD="align: center"]M[/TD]
[TD="align: center"]N[/TD]
[TD="align: center"]O[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"]Q[/TD]
[TD="align: center"]R[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2000[/TD]
[TD="align: center"]2001[/TD]
[TD="align: center"]2002[/TD]
[TD="align: center"]2003[/TD]
[TD="align: center"]2000[/TD]
[TD="align: center"]2001[/TD]
[TD="align: center"]2002[/TD]
[TD="align: center"]2003[/TD]
[TD="align: center"]... to continue up to 30 columns[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]

to consolidate data to (Solution is under the original data)
[TABLE="width: 800"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[TD="align: center"]I[/TD]
[TD="align: center"]J[/TD]
[TD="align: center"]K[/TD]
[TD="align: center"]L[/TD]
[TD="align: center"]M[/TD]
[TD="align: center"]N[/TD]
[TD="align: center"]O[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"]Q[/TD]
[TD="align: center"]R[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2000[/TD]
[TD="align: center"]2001[/TD]
[TD="align: center"]2002[/TD]
[TD="align: center"]2003[/TD]
[TD="align: center"]2000[/TD]
[TD="align: center"]2001[/TD]
[TD="align: center"]2002[/TD]
[TD="align: center"]2003[/TD]
[TD="align: center"]...to continue up to 30 columns[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2000[/TD]
[TD="align: center"]2001[/TD]
[TD="align: center"]2002[/TD]
[TD="align: center"]2003[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]11[/TD]
[TD="align: center"]12[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Thank you in advance for any help
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Code: 
Sub t()
    With ActiveSheet
        For i = 9 To 12
            .Cells(4, i) = .Cells(2, i).Value
            .Cells(5, i) = Application.SumIf(.Cells(2, i).Resize(, 30), .Cells(2, i).Value, .Cells(3, i).Resize(, 30))
        Next
    End With
End Sub
 
Upvote 0
JLGWhiz said:
Code: 
Sub t()
    With ActiveSheet
        For i = 9 To 12
            .Cells(4, i) = .Cells(2, i).Value
            .Cells(5, i) = Application.SumIf(.Cells(2, i).Resize(, 30), .Cells(2, i).Value, .Cells(3, i).Resize(, 30))
        Next
    End With
End Sub
Click to expand...

Hi JLGWhiz,
Thank you very much for your code.
I've just tried it. The first 4 years worked perfectly.
However, because there are more than 4 different years in my data, the rest of the years don't appear. (please see below)
Could you please have a look and update it if possible. Many thanks.

[TABLE="width: 883"]
<colgroup><col><col><col span="2"><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]2005[/TD]
[TD]2006[/TD]
[TD]2008[/TD]
[TD]2018[/TD]
[TD]2016[/TD]
[TD]2018[/TD]
[TD]2005[/TD]
[TD]2006[/TD]
[TD]2008[/TD]
[TD]2010[/TD]
[TD]2010[/TD]
[TD]2006[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]1[/TD]
[TD]7[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]6[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]2[/TD]
[TD]7[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]2005[/TD]
[TD]2006[/TD]
[TD]2008[/TD]
[TD]2018[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]16[/TD]
[TD]13[/TD]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Two questions
1. How many unique years do you have on the row?

2. Do they run consescutively before starting to repeat, or are they randomly distributed?
 
Upvote 0
Disregard post #4 . Try this version.

Code: 
Sub t2()
Dim lr As Long, c As Range, col As Long
lr = ActiveSheet.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
With ActiveSheet
    .Range("I2", .Cells(2, Columns.Count).End(xlToLeft)).Copy
    .Cells(lr + 2, 1).PasteSpecial xlPasteValues, Transpose:=True
    .Cells(lr + 2, 1).CurrentRegion.AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 3), True
    .Cells(lr + 2, 1).CurrentRegion.ClearContents
    .Cells(lr + 2, 3).CurrentRegion.Sort .Cells(lr + 2, 3), xlAscending
    col = 9
    For Each c In .Cells(lr + 2, 2).CurrentRegion.Offset(1)
        If c <> "" Then
            .Cells(4, col) = c.Value
            .Cells(5, col) = Application.SumIf(.Cells(2, col).Resize(, 30), c.Value, .Cells(3, col).Resize(, 30))
            col = col + 1
        End If
    Next
    .Cells(lr + 2, 2).CurrentRegion.ClearContents
End With
End Sub
 
Last edited:
Upvote 0
Hi JLGWhiz
Thank you again for the code.
There are still a bit error when I tried it.
Year 1989 is missing, and it returns 0 for some of the years.
[TABLE="width: 1340"]
<colgroup><col><col span="2"><col span="3"><col span="3"><col span="2"><col><col><col><col><col></colgroup><tbody>[TR]
[TD]2001[/TD]
[TD]2006[/TD]
[TD]2018[/TD]
[TD]2005[/TD]
[TD]2003[/TD]
[TD]2009[/TD]
[TD]2001[/TD]
[TD]2007[/TD]
[TD]2017[/TD]
[TD]2015[/TD]
[TD]2015[/TD]
[TD]1989[/TD]
[TD]2003[/TD]
[TD]2006[/TD]
[TD]1989[/TD]
[TD]2003[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]5[/TD]
[TD]3[/TD]
[TD]9[/TD]
[TD]8[/TD]
[TD]7[/TD]
[TD]12[/TD]
[TD]14[/TD]
[TD]6[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]2001[/TD]
[TD]2001[/TD]
[TD]2003[/TD]
[TD]2005[/TD]
[TD]2006[/TD]
[TD]2007[/TD]
[TD]2009[/TD]
[TD]2015[/TD]
[TD]2017[/TD]
[TD]2018[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]9[/TD]
[TD]7[/TD]
[TD]6[/TD]
[TD]1[/TD]
[TD]8[/TD]
[TD]0[/TD]
[TD]26[/TD]
[TD]7[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Hi JLGWhiz
can you please amend the code, so that the solution overwrite the original data instead of below it.
Thank you.
 
Upvote 0
I believe this fixes the skipped years and zero values. It does not overwrite the original values, but instead deletes the original values on rows 2 and 3 and shifts the new values up. If it had overwritten the original values, then you would have had some of the old values tagged onto the end of the new values, since there were more years entered for the original values.

Code: 
Sub t3()
Dim lr As Long, lc As Long, c As Range, col As Long
lc = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
lr = ActiveSheet.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
With ActiveSheet
    .Range("I2", .Cells(2, Columns.Count).End(xlToLeft)).Copy
    .Cells(lr + 2, 1).PasteSpecial xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    .Cells(lr + 2, 1).CurrentRegion.Sort .Cells(lr + 2, 1), xlAscending
    .Cells(lr + 2, 1).CurrentRegion.AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 3), True
    .Cells(lr + 2, 1).CurrentRegion.ClearContents
    col = 9
    For Each c In .Cells(lr + 2, 3).CurrentRegion.Offset(1)
        If c <> "" Then
            .Cells(4, col) = c.Value
            .Cells(5, col) = Application.SumIf(.Range(.Cells(2, 9), .Cells(2, lc)), c.Value, .Range(.Cells(3, 9), .Cells(3, lc)))
            col = col + 1
        End If
    Next
    .Range(.Cells(2, 9), .Cells(3, lc)).Delete xlShiftUp
    .Cells(lr + 2, 3).CurrentRegion.ClearContents
End With
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Help Please
2 3
Replies
21
Views
486
Asbestos_Jen
Asbestos_Jen
R
  • Solved
Replace last number using provided matrix
2
Replies
15
Views
448
felixstraube
F
D
  • Question Question
If formula with date & VLOOKUP
Replies
1
Views
283
etaf
etaf
K
  • Question Question
conditional formatting question
Replies
2
Views
585
kerm007
K
M
  • Question Question
I need help with VBA/macro script to collect user input and fill cells
Replies
4
Views
505
mumps
mumps

Forum statistics

Threads
1,223,907
Messages
6,175,300
Members
452,633
Latest member
DougMo

Share this page

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
Back
Top