Try this:-
NB:- This code will delete unwanted rows.!!!
Sub MG22Mar01
Dim Rng         As Range
Dim Dn          As Range
Dim Q           As Variant
Dim nRng        As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.value) Then
        .Add Dn.value, Array(Dn, 1)
    Else
     Q = .Item(Dn.value)
        Q(1) = Q(1) + 1
        Q(0).Offset(, Q(1)) = Dn.Offset(, 1)
        If nRng Is Nothing Then
            Set nRng = Dn
        Else
            Set nRng = Union(nRng, Dn)
        End If
     .Item(Dn.value) = Q
End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete

End With

End Sub
Regards Mick