Finding ID number of duplicate entries

[amitz]

Hello everybody.

I have a long list of people (First and Last names) and their one off ID numbers ( no one has the same number but some have the same names).

I am trying to locate all the duplicate entries and in column D to write the ID number of the duplicate entries - there could be 2-8 duplicates. If there were no duplicates then to write NA.

ID Number	First Name	Last Name	ID Number of duplicate (required assistance)
123	Ben	Cook	567, 789, 105
234	Fred	Jay	NA
345	Greg	Lucas	NA
567	Ben	Cook	123, 789, 105
678	Gary	Page	103
789	Ben	Cook	123, 567, 105
100	Lucy	Gray	107, 109
101	Sam	Hanes	NA
103	Gary	Page	678
105	Ben	Cook	123, 567, 789
107	Lucy	Gray	100, 109
109	Lucy	Gray	100, 107

<tbody>
</tbody>

Thanks for your help and time.

 

[MickG]

Try this:-
Results start "D2"

[COLOR="Navy"]Sub[/COLOR] MG08Jun50
[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] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Twn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] nR [COLOR="Navy"]As[/COLOR] Range, Str [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(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
    Twn = Dn.Value & "," & Dn.Offset(, 1).Value
    [COLOR="Navy"]If[/COLOR] Not .Exists(Twn) [COLOR="Navy"]Then[/COLOR]
        .Add Twn, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Twn) = Union(.Item(Twn), Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] nR [COLOR="Navy"]In[/COLOR] .Item(K).Offset(, -1)
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K).Offset(, -1)
            [COLOR="Navy"]If[/COLOR] Not R = nR [COLOR="Navy"]Then[/COLOR]
                Str = Str & ", " & R.Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
    nR.Offset(, 3) = Mid(Str, 2): Str = ""
[COLOR="Navy"]Next[/COLOR] nR
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
 Rng.Offset(, 2).SpecialCells(xlCellTypeBlanks) = "N/A"
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[amitz]

Thank you for your help and time.

After running the code on the data, a number of results are correct, others are partially correct and others incorrect.

I have included the results in column D in BOLD.

Unfortunately, my coding experience isn't sufficient in order to edit the code by myself and point out what should be edited.

Could you please take a look again?

Thanks again for your help.

ID Number	First Name	Last Name	RESULTS WITH CODE	ID Number of duplicate (required assistance)
123	Ben	Cook	567, 105		567, 789, 105
234	Fred	Jay	N/A		NA
345	Greg	Lucas	N/A		NA
567	Ben	Cook	123, 105		123, 789, 105
678	Gary	Page	103		103
789	Ben	Cook	N/A		123, 567, 105
100	Lucy	Gray	107, 109		107, 109
101	Sam	Hanes	N/A		NA
103	Gary	Page	678		678
105	Ben	Cook	123, 567		123, 567, 789
107	Lucy	Gray	100, 109		100, 109
109	Lucy	Gray	100, 107		100, 107

<tbody>
</tbody>

 

[MickG]

The code seems to work for me, Have a look at this example file !!
https://app.box.com/s/t77duqhvtsk5j27cklbgpyr3xcdsf57q