Delete rows in range

[wikus]

I would appreciate any help. I want to delete all duplicate rows in a range leaving only the last instance. There are multiple columns.

Thank you very much.

 

[Peter_SSs]

There are multiple columns.

It is not clear if that means

1. there are multiple columns like the one shown and the deletions have to be done in each column individually, or
2. there is just one column like the one shown but you want us to know that there are other columns containing general data

I have assumed no. 2

It is also not shown what column that is or what row that data starts on. I have assumed it is column A and that there is a heading row and those values to check for dupes start on row 2.

I suggest that you investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with and that would also display all the row/column information that is not seen in the above image.

Try this with a copy of your workbook.

Sub Keep_Last()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a) - 1
    If a(i, 1) = a(i + 1, 1) Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[wikus]

I added a extra column an used this formula: =ISNONTEXT(IF(B1<>B2;COUNTIF($B1:B$2;B1);"")) and Filter on TRUE. The duplicates are in Column B. Looks like it's working.

 

[Peter_SSs]

Glad you have something that works for you. Thanks for letting us know.