Delete duplicate rows keep last entry using vba macro (beginner)

[alksndr]

Hi,

I have a sheet containing duplicate employee ID in column B. So what I would like to do next is to delete those duplicate entries (by row) and will just retain the last entry in the sheet.

Row     Column A   Column B     Column C      Column D
  1       PHMBIA      Maricel A.     Chemical      ---               
  2       PHMBIA      Maricel A.     Chemical      ---
  3       PHMBIA      Maricel A.     Chemical      9/17/2015
  4       PHMABC     Mari L.          Refinery       ---
  5       PHMABC     Mari L.          Refinery       ---
  6       PHMABC     Mari L.          Refinery       ---
  7       PHMABC     Mari L.          Refinery       ---

With this, I would like to delete row #s 1, 2, 4, 5, 6 and will just keep row 3 and 7. the formula should work until the last row with data.


TIA for the help!

 

[WarPigl3t]

Sub mainMacro()
     Dim myArray() As Variant
     a = -1
     ReDim Preserve myArray(0)
     firstRow = 2
     lastRow = Range("B" & Rows.Count).End(xlUp).Row
     r = lastRow
     Do Until r < firstRow
          valueB = Range("B" & r).Value
          addElement = True
          For Each element In myArray
               If element = valueB Then
                    addElement = False
               End If
          Next element
          If addElement = True Then
               a = a + 1
               ReDim Preserve myArray(a)
               myArray(a) = valueB
          Else
               Rows(r).Delete
               r = r + 1
          End If
          r = r - 1
     Loop
End Sub

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26Jun17
[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"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
Lst = Range("B" & Rows.Count).End(xlUp).Row
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = Lst To 1 [COLOR="Navy"]Step[/COLOR] -1
    [COLOR="Navy"]If[/COLOR] Not .Exists(Range("B" & n).Value) [COLOR="Navy"]Then[/COLOR]
        .Add Range("B" & n).Value, Nothing
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Range("B" & n)
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Range("B" & n))
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[alksndr]

Mick - This works perfectly! Thank you!

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26Jun17
[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"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
Lst = Range("B" & Rows.Count).End(xlUp).Row
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = Lst To 1 [COLOR="Navy"]Step[/COLOR] -1
    [COLOR="Navy"]If[/COLOR] Not .Exists(Range("B" & n).Value) [COLOR="Navy"]Then[/COLOR]
        .Add Range("B" & n).Value, Nothing
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Range("B" & n)
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Range("B" & n))
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[MickG]

You're welcome