PDA

View Full Version : [SOLVED] Delete First Duplicate Row



Loss1003
06-26-2015, 10:33 AM
I need some assistance modifying the below code to delete the first duplicate row and not the last duplicate row.




Sub DeleteDups2()

Dim x As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim rngToDel As Range
'change sheet1 to suit
Set ws = ThisWorkbook.Worksheets("Data")


With ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For x = LastRow To 2 Step -1
If Evaluate("=ISNUMBER(MATCH('" & .Name & "'!A" & x & " & '" & .Name & "'!B" & x & ",'" & .Name & "'!A1:A" & x - 1 & " & '" & .Name & "'!B1:B" & x - 1 & ",0))") Then
If rngToDel Is Nothing Then
Set rngToDel = .Range("A" & x)
Else
Set rngToDel = Union(rngToDel, .Range("A" & x))
End If
End If
Next x
End With


If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete
End Sub




Thanks!

p45cal
06-26-2015, 11:54 AM
try:
Sub DeleteDups3()

Dim x As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim rngToDel As Range
'change sheet1 to suit
Set ws = ThisWorkbook.Worksheets("Data")


With ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow - 1
If Evaluate("=ISNUMBER(MATCH('" & .Name & "'!A" & x & " & '" & .Name & "'!B" & x & ",'" & .Name & "'!A" & x + 1 & ":A" & LastRow & " & '" & .Name & "'!B" & x + 1 & ":B" & LastRow & ",0))") Then
If rngToDel Is Nothing Then
Set rngToDel = .Range("A" & x)
Else
Set rngToDel = Union(rngToDel, .Range("A" & x))
End If
End If
Next x
End With


If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete
End Sub

Loss1003
06-26-2015, 12:02 PM
Thanks worked perfectly.