VBA to merge duplicate rows and sum values in certain column

A

aydinrotar

New Member
Joined
Jul 11, 2017
Messages
10
Hi,

I'm trying to automate a really long task I have to preform daily at work with VBA and although I'm almost a complete noob with VBA, I have managed to get majority of it done except for this one last step, so any help would be greatly appreciated.

Basically I have a worksheet with 4 columns of data, I'm looking for some code to check the values in column A and if there's a duplicate, merge the duplicates and sum the values only in column D.

Example:

I need something like this..

[TABLE="width: 500"]
<tbody>[TR]
[TD]NUMBER[/TD]
[TD]NAME[/TD]
[TD]CODE[/TD]
[TD]HOURS[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]John Smith[/TD]
[TD]410[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]John Smith[/TD]
[TD]410[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]John Smith[/TD]
[TD]410[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jane Smith[/TD]
[TD]410[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jane Smith[/TD]
[TD]410[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jane Smith[/TD]
[TD]410[/TD]
[TD]6.5[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jane Smith[/TD]
[TD]410[/TD]
[TD]6.5[/TD]
[/TR]
</tbody>[/TABLE]

To turn into this..

[TABLE="width: 500"]
<tbody>[TR]
[TD]NUMBER[/TD]
[TD]NAME[/TD]
[TD]CODE[/TD]
[TD]HOURS[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]John Smith[/TD]
[TD]410[/TD]
[TD]22[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jane Smith[/TD]
[TD]410[/TD]
[TD]27[/TD]
[/TR]
</tbody>[/TABLE]


Note: Columns A,B and C will always have the same value if they're a duplicate and only column D needs to be added.


I've found this online but cannot for the life of me work out how to customize it to suite my needs:

Code: 
[COLOR=blue]Sub[/COLOR] test() 
    [COLOR=blue]Dim[/COLOR] a, i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], ii [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], n [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR] 
    a = Sheets("STO REV").Cells(1).CurrentRegion.Value 
    n = 1 
    [COLOR=blue]With[/COLOR] CreateObject("Scripting.Dictionary") 
        [COLOR=blue]For[/COLOR] i = 2 [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](a, 1) 
            [COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] .exists(a(i, 2)) [COLOR=blue]Then[/COLOR] 
                n = n + 1: .Item(a(i, 2)) = n 
                [COLOR=blue]For[/COLOR] ii = 1 [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](a, 2) 
                    a(n, ii) = a(i, ii) 
                [COLOR=blue]Next[/COLOR] 
            [COLOR=blue]Else[/COLOR] 
                a(.Item(a(i, 2)), 5) = a(.Item(a(i, 2)), 5) + a(i, 5) 
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
        [COLOR=blue]Next[/COLOR] 
    [COLOR=blue]End With[/COLOR] 
    [COLOR=blue]With[/COLOR] Sheets.Add().Cells(1).Resize(n, [COLOR=blue]UBound[/COLOR](a, 2)) 
        .Value = a 
        .Columns.AutoFit 
    [COLOR=blue]End With[/COLOR] 
[COLOR=blue]End Sub[/COLOR][COLOR=blue]
[/COLOR]

Again, any help would really be appreciated
 
Sort by date Sort by votes
Please start a new thread, Quoting this thread reference and showing an example of your data with expected results.
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
@salman94
Please do not make any further post to this thread ( I have removed the last 2 you made)

As mentioned by MickG you need to start a new thread, explaining what you are after, along with some sample data.
 
Upvote 0
HI MickG, ur code was perfectly what I wanted, I wanted it to sum and indeed delete duplicate. but please say I want it to sum and delete for multiple columns simultaneously, what do I do.
 
Upvote 0
Please start a new thread, Quoting this thread reference and showing an example of your data with expected results.
 
Upvote 0
Hi Mick

I'd like to add a new column to the data. And the function of the code should remain the same, but take into account of the new Row.
Please see below for details. Thanks a million.

Raw data:
[TABLE="width: 1088"]
<colgroup><col span="17"></colgroup><tbody>[TR]
[TD][/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[TD]O[/TD]
[TD]P[/TD]
[TD]Q[/TD]
[TD]R[/TD]
[TD]S[/TD]
[TD]T[/TD]
[TD]U[/TD]
[TD]V[/TD]
[TD]W[/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]john[/TD]
[TD]Karen[/TD]
[TD]darren[/TD]
[TD]John[/TD]
[TD]John[/TD]
[TD]Karen[/TD]
[TD]darren[/TD]
[TD]karen[/TD]
[TD]John[/TD]
[TD]darren[/TD]
[TD]darren[/TD]
[TD]karen[/TD]
[TD]John[/TD]
[TD]… …[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]2000[/TD]
[TD]2018[/TD]
[TD]2001[/TD]
[TD]2000[/TD]
[TD]2017[/TD]
[TD]2015[/TD]
[TD]2001[/TD]
[TD]2015[/TD]
[TD]2017[/TD]
[TD]2001[/TD]
[TD]2018[/TD]
[TD]2015[/TD]
[TD]2016[/TD]
[TD]… …[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]2[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]8[/TD]
[TD]10[/TD]
[TD]4[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]2[/TD]
[TD]5[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]8[/TD]
[TD]… …[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[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][/TD]
[/TR]
[TR]
[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][/TD]
[/TR]
[TR]
[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][/TD]
[/TR]
[TR]
[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][/TD]
[/TR]
[TR]
[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][/TD]
[/TR]
[TR]
[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][/TD]
[/TR]
[TR]
[TD="colspan: 2"]After code is run[/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]
[TR]
[TD][/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[TD]O[/TD]
[TD]P[/TD]
[TD]Q[/TD]
[TD]R[/TD]
[TD]S[/TD]
[TD]T[/TD]
[TD]U[/TD]
[TD]V[/TD]
[TD]W[/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]john[/TD]
[TD]darren[/TD]
[TD]Karen[/TD]
[TD]John[/TD]
[TD]John[/TD]
[TD]darren[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]… …[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]2000[/TD]
[TD]2001[/TD]
[TD]2015[/TD]
[TD]2016[/TD]
[TD]2017[/TD]
[TD]2018[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]… …[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]10[/TD]
[TD]18[/TD]
[TD]9[/TD]
[TD]8[/TD]
[TD]12[/TD]
[TD]6[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]… …[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[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][/TD]
[/TR]
[TR]
[TD="colspan: 11"]To Sort Row 2 and consolidate numbers in Row 3, but if value in Row 1 is different, it would not combine. [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG15Jun51
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
 [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("I1"), Cells(1, Columns.Count).End(xlToLeft))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
Application.ScreenUpdating = False
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = UCase(Dn.Value & Dn.Offset(1).Value)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
        .Add Txt, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = _
        Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        .Item(Txt).Offset(2) = .Item(Txt).Offset(2) + Dn.Offset(2)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng
    Dn.Resize(3).ClearContents
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] If
Rng.Resize(3).Sort Key1:=Range("I2"), Orientation:=xlLeftToRight
[COLOR="Navy"]End[/COLOR] With
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mick
I've just checked figures again. It seems that the names in Row 1 don't follow the value in Row 2 & 3. Numbers under Karen & Darren don't add up right. Could you please check it out. Thank you.
And consolidating, the names with no values under them are still there.


[TABLE="width: 832"]
<tbody>[TR]
[TD="class: xl65, width: 64"]john[/TD]
[TD="class: xl65, width: 64"]Karen[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[TD="class: xl65, width: 64"]Karen[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]karen[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]karen[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]2000[/TD]
[TD="class: xl65, width: 64"]2001[/TD]
[TD="class: xl65, width: 64"]2015[/TD]
[TD="class: xl65, width: 64"]2016[/TD]
[TD="class: xl65, width: 64"]2017[/TD]
[TD="class: xl65, width: 64"]2018[/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]10[/TD]
[TD="class: xl65, width: 64"]18[/TD]
[TD="class: xl65, width: 64"]9[/TD]
[TD="class: xl65, width: 64"]8[/TD]
[TD="class: xl65, width: 64"]12[/TD]
[TD="class: xl65, width: 64"]6[/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[/TR]
[TR]
[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]
[TR]
[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]
[TR]
[TD="class: xl65, width: 64"]john[/TD]
[TD="class: xl65, width: 64"]Karen[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[TD="class: xl65, width: 64"]Karen[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]karen[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]darren[/TD]
[TD="class: xl65, width: 64"]karen[/TD]
[TD="class: xl65, width: 64"]John[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]2000[/TD]
[TD="class: xl65, width: 64"]2018[/TD]
[TD="class: xl65, width: 64"]2001[/TD]
[TD="class: xl65, width: 64"]2000[/TD]
[TD="class: xl65, width: 64"]2017[/TD]
[TD="class: xl65, width: 64"]2015[/TD]
[TD="class: xl65, width: 64"]2001[/TD]
[TD="class: xl65, width: 64"]2015[/TD]
[TD="class: xl65, width: 64"]2017[/TD]
[TD="class: xl65, width: 64"]2001[/TD]
[TD="class: xl65, width: 64"]2018[/TD]
[TD="class: xl65, width: 64"]2015[/TD]
[TD="class: xl65, width: 64"]2016[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]2[/TD]
[TD="class: xl65, width: 64"]5[/TD]
[TD="class: xl65, width: 64"]10[/TD]
[TD="class: xl65, width: 64"]8[/TD]
[TD="class: xl65, width: 64"]10[/TD]
[TD="class: xl65, width: 64"]4[/TD]
[TD="class: xl65, width: 64"]3[/TD]
[TD="class: xl65, width: 64"]4[/TD]
[TD="class: xl65, width: 64"]2[/TD]
[TD="class: xl65, width: 64"]5[/TD]
[TD="class: xl65, width: 64"]1[/TD]
[TD="class: xl65, width: 64"]1[/TD]
[TD="class: xl65, width: 64"]8[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
Hi Mick
I've tested with more data.
It worked perfectly. I'm sorry, please ignore my previous post. it's probably I didn't paste the VBA code correctly.
Thanks again for all your time and effort to help.
Kind regards
 
Upvote 0
Hi Mick

Is there a way of editing this code so that it compares if 2 cells in a row are the same, not just one?

Many thanks

sam
 
Upvote 0
You must log in or register to reply here.

Similar threads

airforceone
  • Solved
Populate Rows & Columns by Comma Split
2
Replies
12
Views
351
airforceone
airforceone
H
  • Solved
Merging Duplicate Rows and time entries
Replies
5
Views
291
alansidman
A
M
  • Question Question
select value two columns to the left of variable in an array
Replies
1
Views
270
myall_blues
myall_blues
J
  • Solved
VBA to merge duplicate rows and sum values in certain column with adjustments
Replies
9
Views
857
Alex Blakenburg
A
A
  • Solved
adapting code to merge amount for duplicates item on usrform
Replies
4
Views
299
abdo meghari
A

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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