Delete Duplicates VBA

Question

I am trying to erase duplicate rows starting from bottom, but it isnt working. It keeps two copies but deletes other duplicate items.

With wb_DST.Sheets(sWs_DST)
    lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row
    wb_DST.Sheets(sWs_DST).Range(("A13:A" & lncheckduplicatescolumn - 2 & ":" & "AW13:AW" & lncheckduplicatescolumn - 2)).Sort key1:=wb_DST.Sheets(sWs_DST).Range("A13:A" & lncheckduplicatescolumn - 2), order1:=xlDescending, Header:=xlNo

    Dim row As Range
    Dim rng As Range
    Dim cell As Range
    Dim i As Integer
    Set rng = wb_DST.Sheets(sWs_DST).Range("A13:A" & lncheckduplicatescolumn - 2)
    For Each cell In rng
        If cell.Value = cell.Offset(-1, 0).Value Then
            .cell.Offset(-1, 0).EntireRow.Delete
        End If
    Next
End with

If Excel shows

Column A       Column B
A                 1
A                 2
A                 3

I want the code to retain the last row, and delete the ones above it.

The result should be

Column A            Column B
A                    3

Thanks,

Your code isn't deleting duplicates, it deletes a duplicate only if there's a second one above it. — PlamZ
– PlamZ, Commented Dec 5, 2017 at 20:30
what does this even mean? It keeps two copies but deletes other duplicate items. ... be very specific when describing problems. — jsotola
– jsotola, Commented Dec 5, 2017 at 20:31
Sorry for the confusion. I need the code to delete any duplicates. Right now it doesn't function correctly. I need the code to delete any duplicates, and keep the data from the bottom. An example is given above. — SM123
– SM123, Commented Dec 5, 2017 at 20:35

user4039065 · Accepted Answer · 2017-12-05 20:45:06Z

1

Work from the bottom up and loop until all 'higher' (i.e. in a row less than current) are removed.

dim dup as variant, r as long, lncheckduplicatescolumn as long
With wb_DST.Sheets(sWs_DST)
    lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row
    for r = lncheckduplicatescolumn  to 2 step -1
        dup = application.match(.cells(r, "A").value, .columns(1), 0)
        if dup < r then .rows(dup).delete
    next r
end with

This will take a few more cycles than is absolutely necessary but the operation is efficient enough that it should not make a significant difference.

answered Dec 5, 2017 at 20:45

user4039065

Sign up to request clarification or add additional context in comments.

3 Comments

SM123 Over a year ago

This works great, however is too slow for large sets of data, what do u recommend??

user4039065 Over a year ago

That sounds like a new question as this appears to have answered your original question given the details you ave provided. It would depend on the actual data. I might try a dictionary object constructed from a variant array of the actual values. Calculation cycles and event handling can also slow things down but you can suspend both of those. You might try posting a new question based on my code with details of the actual data at Code Review.

SM123 Over a year ago

I just did, apprecaite your help.

Issel · Accepted Answer · 2017-12-05 20:49:18Z

0

Dim x as integer
Dim y as string
Dim J as integer
Dim I as integer

x = activesheet.range("A" & Activesheet.range("A1").endxl.down).count 'This will count the total number of rows. 


for i = x to 2 'this should count backwards from bottom to top, since you have headers, stop at row 2
 y = Activesheet.range("A" & i).value 'places value in a variable
      For j = x - i - 1 to 1 'this is another loop, but it should start above the whatever the cell that Y got its value 
        if activesheet.range("a" & j).value = y then 'comparison
            'do what you need to delete the row
        end if

Next
Next

I think this will go start at the bottom, put that first value in a variable, and then will go through the rest of the list check the values to see if is compatible. The second for loop might need to be adjusted.

answered Dec 5, 2017 at 20:49

Issel

1416 bronze badges

1 Comment

user4039065 Over a year ago

for i = x to 2 needs to be for i = x to 2 STEP -1 and all of the vars for rows should be Long, not Integer.

henrythedj · Accepted Answer · 2017-12-05 20:49:34Z

not a pretty answer - but from what it looks like, you should be ending up with the last and first occurrence of the duplicate:

 Column A    Column B
 A           1
 A           3

To patch your answer (there are more elegant ways), you could find the last row again after the loop is finished and check for one last duplicate:

 For Each cell In rng
    If cell.Value = cell.Offset(-1, 0).Value Then
        .cell.Offset(-1, 0).EntireRow.Delete
    End If
 Next

redefine your last row

 lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row

and check for one more duplicate

 If Range("A" & lncheckduplicatescolumn).Value = Range("A" & lncheckduplicatescolumn).Offset(-1, 0).Value Then
    .cell.Offset(-1, 0).EntireRow.Delete
 End If

Collectives™ on Stack Overflow

Delete Duplicates VBA

3 Answers 3

3 Comments

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

3 Comments

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related