Find and Delete Duplicates But Keep The First One

[transparencia]

I want to delete duplicates rows but keep the first one of each duplicate set.

Example:
(The Red Rows are Removed)

Row 1___1000____________20
Row 2___1000 ___________ 20
Row 3___1000 ___________ 20

How can I this with a VBA function?

 

[jeffreybrown]

Hello & Welcome to the Board,

Do your columns have a header row? I'm guessing it would just be two columns.

If so change Header:=xlNo to xlYes

Sub test()
    Dim LR As Long: LR = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("A1:B" & LR).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

 

[VoG]

Try

Sub test2()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    With Range("A" & i)
        If .Value = .Offset(-1).Value And .Offset(, 1).Value = .Offset(-1, 1).Value Then .EntireRow.Delete
    End With
Next i
End Sub

 

[transparencia]

Thanks guys but I'm not sure how to apply those functions because I forgot to add that I added a helper column that concatenates everything, like this:

Col A___Col B__________Col C______Col D
Row 1___1000____________20_________100020
Row 2___1000 ___________ 20__________100020
Row 3___1000 ___________ 20__________100020


How can I apply the above functions to COL D? And can I just have the rows selected so I can delete them manually?

 

[VoG]

Try

Sub test2()
Dim LR As Long, i As Long, r As Range
LR = Range("D" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    With Range("D" & i)
        If .Value = .Offset(-1).Value Then
            If r Is Nothing Then
                Set r = Range("D" & i)
            Else
                Set r = Union(r, Range("D" & i))
            End If
        End If
    End With
Next i
If Not r Is Nothing Then r.EntireRow.Select
End Sub

 

[transparencia]

VoG:

That last function doesn't seem to do anything. It's executed very fast and doesn't select anything.

 

[VoG]

It worked when I tested it. The sheet must be the active sheet when you run it, and sorted as in your example. Maybe

Sub test2()
Dim LR As Long, i As Long, r As Range
LR = Range("D" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    With Range("D" & i)
        If .Value = .Offset(-1).Value Then
            If r Is Nothing Then
                Set r = Range("D" & i)
            Else
                Set r = Union(r, Range("D" & i))
            End If
        End If
    End With
Next i
If r Is Nothing Then
    MsgBox "No duplicates found"
Else
    r.EntireRow.Select
End If
End Sub

 

[transparencia]

It does work!

Thanks a lot, Peter (you're the man)!!!! And the other guy on top!