Finding duplicates based on two columns and changing values VBA

[christian2016]

Hi Guys,

I have a range of data.

I need help writing a VBA code to see if the code column matches more than one name then if it does to only change the value of that code to the ext code.

So in this case it will only change Data 2 and data 3 as they both have the same Code numbers.

Any help is greatly appreciated. Tried to do it myself although can't figure it out.

Thanks

Example below before and after.

Existing Data
Code    Name    Ext Code
7216    Data1    7216 - 410
7216    Data1    7216 - 410
7216    Data1    7216 - 410
7216    Data1    7216 - 410
7216    Data2    7216 - 521
7216    Data1    7216 - 410
7216    Data2    7216 - 521
7216    Data3    7216 - 610
7216    Data1    7216 - 410
7156    Data1    7156 - 111
7156    Data1    7156 - 111

After Executing VBA Code
Code             Name          Ext Code
7216               Data1    7216 - 410
7216               Data1    7216 - 410
7216               Data1    7216 - 410
7216               Data1    7216 - 410
[B]7216 - 521         Data2    7216 - 521[/B]
7216               Data1    7216 - 410
[B]7216 - 521 [/B]      [B]  Data2    7216 - 521[/B]
[B]7216 - 610         Data3    7216 - 610[/B]
7216               Data1    7216 - 410
7156               Data1    7156 - 111
7156               Data1    7156 - 111

 

[MickG]

Try this:- ???

[COLOR="Navy"]Sub[/COLOR] MG19Mar43
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
       
        [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Dn
        [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = _
                Union(Dic(Dn.Value).Item(Dn.Offset(, 1).Value), Dn)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
   
   
    
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
        c = 0
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
             c = c + 1
             [COLOR="Navy"]If[/COLOR] c > 1 [COLOR="Navy"]Then[/COLOR]
               [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Dic(k).Item(p)
                    Dn = Dn.Value & " - " & Split(Dn.Offset(, 2), " - ")(1)
                    Dn.Resize(, 4).Font.Bold = True
               [COLOR="Navy"]Next[/COLOR] Dn
             [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] p
    [COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick