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

[sommerfeld]

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

Interest	Email	Desired Output
Oranges	ab@xyz.com	Oranges and Pears and Bananas
Pears	ab@xyz.com	Oranges and Pears and Bananas
Bananas	ab@xyz.com	Oranges and Pears and Bananas
Oranges	cd@xyz.com	Oranges
Pears	ef@xyz.com	Pears and Bananas
Bananas	ef@xyz.com	Pears and Bananas

<tbody>
</tbody>

 

[MickG]

Try this:-

[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

 

[sommerfeld]

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 Resources	13439256169@163.com
GP in Energy, Utilities and Natural Resources	2591533989@qq.com
GP in Information Technology	2591533989@qq.com
GP in Information Technology	2kanghak@utc.co.kr
GP in Energy, Utilities and Natural Resources	a.adepoju@alphaafrican.com
GP in Information Technology	a.adepoju@alphaafrican.com
GP in Energy, Utilities and Natural Resources	a.aljawhary@jequitypartners.com
GP in Energy, Utilities and Natural Resources	a.alturki@energycapitalgrp.com
GP in Energy, Utilities and Natural Resources	a.amati@meta-group.com
GP in Clean Tech	a.amati@meta-group.com
GP in Information Technology	a.amati@meta-group.com
GP in Energy, Utilities and Natural Resources	a.anselmo@meta-group.com
GP in Clean Tech	a.anselmo@meta-group.com
GP in Information Technology	a.anselmo@meta-group.com
GP in Energy, Utilities and Natural Resources	a.antipov@leader-invest.ru
GP in Clean Tech	a.antipov@leader-invest.ru
GP in Information Technology	a.antipov@leader-invest.ru

<colgroup><col><col></colgroup><tbody>
</tbody>

 

[MickG]

Sorry I omitted a "End With" at bottom of code, Try this:-

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.

 

[sommerfeld]

That is just brilliant!! It worked first time. If I can return the favour Mick, please let me know.

Thanks very much.

Antony Sommerfeld

 

[MickG]

You're welcome