CODEWITHSUNDEEP
vbaexcel
Kuma
Kuma

Reputation: 57

Delete duplicates if they are together in a column excel

I am trying to delete entire row if duplicates are found together. If not found together I want to keep it without deleting. 

For an example Column A:
Apple,
Apple,
Orange,
Orange,
Apple,
Apple,

I need to have the output as;

Apple,
Orange,
Apple,

I'm using the following code but have not achieved the desired output yet (only get Apple, Orange).

   Sub FindDuplicates()
   Dim LastRow, matchFoundIndex, iCntr As Long
   LastRow = Cells(Rows.Count, "A").End(xlUp).Row
   For iCntr = 1 To LastRow      
   If Cells(iCntr, 1) <> "" Then
   matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" &      LastRow), 0)
   If iCntr <> matchFoundIndex Then
   Cells(iCntr, 10) = "Duplicate"
   End If
   End If
   Next

   last = Cells(Rows.Count, "J").End(xlUp).Row ' check results col for values
   For i = last To 2 Step -1
   If (Cells(i, "J").Value) = "" Then
   Else
   Cells(i, "J").EntireRow.Delete  ' if values then delete
   End If
   Next i
   End Sub

Upvotes: 3

Views: 103

Answers (2)

Pspl
Pspl

Reputation: 1474

Doesn't something simple like 

Dim LastRow As Long
Application.screenUpdating=False
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
    If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
        Cells(i, 1).EntireRow.Delete
    End If
Next i
Application.screenUpdating=True

solve this?

Upvotes: 6

user4039065
user4039065

Reputation:

Work from the bottom up and only delete if the cell above is the same value.

dim r as long

with worksheets("sheet1")
    for r = .cells(.rows.count, "A").end(xlup).row to 2 step -1
        if lcase(.cells(r, "A").value2) = lcase(.cells(r - 1, "A").value2) then
            .rows(r).entirerow.delete
        end if
    next r
end with

If you do not want the comparison to be case-insensitive then remove the lcase functions.

Upvotes: 2

Related Questions