Identifying duplicate values and then returning a combined value if duplicates exist

sommerfeld

New Member
Joined
Apr 4, 2016
Messages
12
Hi, can anyone help with with this problem.

I have a list of data where I've done a conditional format to identify duplicate email addresses. I've tagged each email address relevant to the user's interest. So imagine you had a user who had three interests and another with 2 and another with 1 and another with 3 etc. How could I get the output so that if a duplicate value exists, one adjacent cell contacts their interests all in one cell and not separately? Example of below of what I mean and the desired output.

Many thanks in advance!!

Antony


InterestEmailDesired Output
Orangesab@xyz.comOranges and Pears and Bananas
Pearsab@xyz.com Oranges and Pears and Bananas
Bananasab@xyz.com Oranges and Pears and Bananas
Orangescd@xyz.comOranges
Pearsef@xyz.comPears and Bananas
Bananasef@xyz.comPears and Bananas

<tbody>
</tbody>
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG27Feb13
[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]
[COLOR="Navy"]Set[/COLOR] Rng = Range("B2", Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Offset(, -1)
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & " and " & Dn.Offset(, -1).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
  Dn.Offset(, 1).Value = .Item(Dn.Value)
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mick for replying! I'm a bit slow with Excel. If I had the following info (real info), then I'm inserting the code as a module > saving as a macro enabled workbook > ALT+Q > ALT+F8 > RUN. If that's correct then the response I get is "Invalid outside procedure".

Below is actual data. Emails in column B, input in A. I'd like the output in column C. Any idea what amendment to your code I'd need to make?

Thanks, Antony


COLUMN A COLUMN B

GP in Energy, Utilities and Natural Resources13439256169@163.com
GP in Energy, Utilities and Natural Resources2591533989@qq.com
GP in Information Technology2591533989@qq.com
GP in Information Technology2kanghak@utc.co.kr
GP in Energy, Utilities and Natural Resourcesa.adepoju@alphaafrican.com
GP in Information Technologya.adepoju@alphaafrican.com
GP in Energy, Utilities and Natural Resourcesa.aljawhary@jequitypartners.com
GP in Energy, Utilities and Natural Resourcesa.alturki@energycapitalgrp.com
GP in Energy, Utilities and Natural Resourcesa.amati@meta-group.com
GP in Clean Techa.amati@meta-group.com
GP in Information Technologya.amati@meta-group.com
GP in Energy, Utilities and Natural Resourcesa.anselmo@meta-group.com
GP in Clean Techa.anselmo@meta-group.com
GP in Information Technologya.anselmo@meta-group.com
GP in Energy, Utilities and Natural Resourcesa.antipov@leader-invest.ru
GP in Clean Techa.antipov@leader-invest.ru
GP in Information Technologya.antipov@leader-invest.ru

<colgroup><col><col></colgroup><tbody>
</tbody>
 
Upvote 0
Sorry I omitted a "End With" at bottom of code, Try this:-
Code:
Sub MG27Feb13()
Dim Rng As Range, Dn As Range, n As Long
Set Rng = Range("B2", Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn.Offset(, -1)
    Else
        .Item(Dn.Value) = .Item(Dn.Value) & " and " & Dn.Offset(, -1).Value
    End If
Next

For Each Dn In Rng
  Dn.Offset(, 1).Value = .Item(Dn.Value)
Next Dn
End With
End Sub

Also :-
To Save and Run Code:-
Copy code from Thread
In Your Data sheet , Click "Alt+F11",:- Vb Window appears.
From the VBWindow toolbar, Click "Insert" ,"Module":- New VBwindow appears .
Paste Code into this window.
Close Vbwindow.

On sheet Click "Developer tab", Click "Macro". Macro dialog box appears.
Select Macro (with same name) from List.
On the right of Dialog box Click "Run"
The Sheet should now be updated.
Regrds Mick

PS:- Data assumed to start row 2.
 
Last edited:
Upvote 0
That is just brilliant!! It worked first time. If I can return the favour Mick, please let me know.

Thanks very much.

Antony Sommerfeld
 
Upvote 0

Forum statistics

Threads
1,196,413
Messages
6,015,119
Members
441,872
Latest member
Jyyyyyyyy

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