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


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Interest[/TD]
[TD]Email[/TD]
[TD]Desired Output[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD]ab@xyz.com[/TD]
[TD]Oranges and Pears and Bananas[/TD]
[/TR]
[TR]
[TD]Pears[/TD]
[TD]ab@xyz.com [/TD]
[TD]Oranges and Pears and Bananas[/TD]
[/TR]
[TR]
[TD]Bananas[/TD]
[TD]ab@xyz.com [/TD]
[TD]Oranges and Pears and Bananas[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD]cd@xyz.com[/TD]
[TD]Oranges[/TD]
[/TR]
[TR]
[TD]Pears[/TD]
[TD]ef@xyz.com[/TD]
[TD]Pears and Bananas[/TD]
[/TR]
[TR]
[TD]Bananas[/TD]
[TD]ef@xyz.com[/TD]
[TD]Pears and Bananas
[/TD]
[/TR]
</tbody>[/TABLE]

 

[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


[TABLE="width: 499"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]COLUMN A [/TD]
[TD]COLUMN B

[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]13439256169@163.com[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]2591533989@qq.com[/TD]
[/TR]
[TR]
[TD]GP in Information Technology[/TD]
[TD]2591533989@qq.com[/TD]
[/TR]
[TR]
[TD]GP in Information Technology[/TD]
[TD]2kanghak@utc.co.kr[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]a.adepoju@alphaafrican.com[/TD]
[/TR]
[TR]
[TD]GP in Information Technology[/TD]
[TD]a.adepoju@alphaafrican.com[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]a.aljawhary@jequitypartners.com[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]a.alturki@energycapitalgrp.com[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]a.amati@meta-group.com[/TD]
[/TR]
[TR]
[TD]GP in Clean Tech[/TD]
[TD]a.amati@meta-group.com[/TD]
[/TR]
[TR]
[TD]GP in Information Technology[/TD]
[TD]a.amati@meta-group.com[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]a.anselmo@meta-group.com[/TD]
[/TR]
[TR]
[TD]GP in Clean Tech[/TD]
[TD]a.anselmo@meta-group.com[/TD]
[/TR]
[TR]
[TD]GP in Information Technology[/TD]
[TD]a.anselmo@meta-group.com[/TD]
[/TR]
[TR]
[TD]GP in Energy, Utilities and Natural Resources[/TD]
[TD]a.antipov@leader-invest.ru[/TD]
[/TR]
[TR]
[TD]GP in Clean Tech[/TD]
[TD]a.antipov@leader-invest.ru[/TD]
[/TR]
[TR]
[TD]GP in Information Technology[/TD]
[TD]a.antipov@leader-invest.ru[/TD]
[/TR]
</tbody>[/TABLE]

 

[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