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?
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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:

Watch MrExcel Video

Forum statistics

Threads
1,095,372
Messages
5,444,074
Members
405,265
Latest member
Iram

This Week's Hot Topics

Top