VBA: Merging rows based on duplicate values in two columns

a098p

New Member
Joined
Aug 14, 2019
Messages
8
I am trying to merge rows based on duplicate values in two columns. Specifically, look at the two screenshots below. If entries under Last Name (Column B) and Email (Column C) match in any two rows, then they should be merged.

This is what it looks like originally:

First NameLast NameEmail AddressCell PhoneOrganization NameOrganization TypeJob Title/Designation
ABCPQRabcpqr@test.comxxxxxxxxxx
ABCPQRabcpqr@test.comXYZMNCStudent

<tbody>
</tbody>







This is what I would like it to look like:

First NameLast NameEmail AddressCell PhoneOrganization NameOrganization TypeJob Title/Designation
ABCPQRabcpqr@test.comxxxxxxxxxxXYZMNCStudent

<tbody>
</tbody>







In my workbook, a user is likely to copy paste rows of data and will then run a macro to check for duplicates across Column B and Column C and then merge them if found. There are many more columns than the ones displayed here and the user will be adding new columns so I would like the merge to occur across the entire row. Is there any way to do this?
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Try this:-
NB:- This code will alter your Data, and delete duplicate rows !!!
Code:
[COLOR="Navy"]Sub[/COLOR] MG17Aug22
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Lst = ActiveSheet.Cells(1).CurrentRegion.Columns.Count
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    txt = 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"]For[/COLOR] Ac = 2 To Lst - 1
            [COLOR="Navy"]If[/COLOR] .Item(txt).Offset(, Ac) = "" [COLOR="Navy"]Then[/COLOR]
                .Item(txt).Offset(, Ac) = Dn.Offset(, Ac)
            [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] Ac
   [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)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,309
Members
448,564
Latest member
ED38

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