Merging Duplicates

[mharper90]

I have a roster of people with names in column B and number data about them in columns H, I, J, K. Column A has a descriptor about the person. Everyone has the descriptor of "NO" in column A when they are added to the roster. If they are added again, they are given the descriptor in column A of "DPL".

Every so often I need to find all of the duplicate names, "DPL", and merge them with their initial entry, "NO". All of the corresponding number data in columns H, I, J, K should be summed and replace the values originally associated with the initial entry, "NO". Then the rows of duplicate entries, "DPL", should be deleted since the data has been merged.

I'm struggling to start this macro. Can someone give me a helping start? Thanks!

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG13Nov08
Private [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
[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] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[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
  [COLOR="Navy"]If[/COLOR] Dn.Offset(, -1).Value = "NO" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Dn
  [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, -1).Value = "DPL" [COLOR="Navy"]Then[/COLOR]
       [COLOR="Navy"]If[/COLOR] .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] ac = 6 To 9
            .Item(Dn.Value).Offset(, ac) = .Item(Dn.Value).Offset(, ac) + Dn.Offset(, ac)
        [COLOR="Navy"]Next[/COLOR] ac
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
       [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick