Delete non-duplicate rows

[greatavion]

Hello folks,

I have a spreadsheet that contains many rows of data. Some of the cell values in column F are duplicates while others are unique and there is only one instance. I would like to use VBA to delete the rows that contain unique values in column F, while leaving the duplicate values (+ their corresponding rows) found in column F.

I have used the below piece of code and it works fine. The problem is the data in Column B disappears on execution of the below code. As I am new to vba, unable to figure out what is the root cause.

Sub Unique_Delete()
Dim UsdRws As Long

UsdRws = Range("A" & Rows.Count).End(xlUp).Row
With Cells(1, Columns.Count).End(xlToLeft).Offset(1, 1).Resize(UsdRws)
.Formula = "=if(countifs(f:f,f2)>1,"""",1)"
.Value = .Value
.SpecialCells(xlConstants).EntireRow.Delete
End With
End Sub

Any assistance would be greatly appreciated.

 

[Jimmypop]

Hello...

Have you tried?

Option Explicit

Sub Unique_Delete()
    Dim UsdRws As Long
    Dim i As Long
    
    UsdRws = Range("A" & Rows.Count).End(xlUp).Row
    For i = UsdRws To 2 Step -1
        If WorksheetFunction.CountIfs(Range("F:F"), Range("F" & i)) = 1 Then
            Rows(i).Delete
        End If
    Next i
End Sub

This code loops through each row from the last row to the second row and checks whether the value in column F has a count of 1 (i.e., is unique). If so, it deletes only that row.

Note: Make sure to test this code on a copy of your data before running it on your actual spreadsheet.