Eliminate one of the two duplicate values with a macro

Question

in column A, I would like to check if there are cells with equal values and if I find them I would like one of them to be deleted, but with this macro, I delete both cells

Sub Elina_Tutti_I_Doppioni_2()
    Dim LastRow As Long, K As Long, MemoCanc As Variant
    
    Application.ScreenUpdating = False

    With ActiveSheet
        .Columns("A").Sort .[a1], Header:=xlGuess
        LastRow = [COUNTA(A:A)]
 
        For K = LastRow To 2 Step -1
            If .Cells(K, 1) = .Cells(K - 1, 1) Or MemoCanc = .Cells(K, 1) Then
                MemoCanc = .Cells(K, 1)
                .Rows(K).EntireRow.Delete
            End If
        Next
    End With
  
    Application.ScreenUpdating = True
End Sub

You are setting `MemoCanc` to the value you are deleting, so the 2nd half of your IF will always be true, as you are stepping -1, and checking the row-1 So if "a" is in row 19 & 20, then you delete row 20, but row 19 is also "a", and set `MemoCanc` to "a" so row 19 will be `MemoCanc` I dont think you need the memocanc. — Nathan_Sav, Jul 21 '21 at 07:08
`LastRow = [COUNTA(A:A)]` I would not recommned using this method to find last row. You may want to see [THIS](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba/11169920#11169920) — Siddharth Rout, Jul 21 '21 at 07:37
Also Excel remembers the last setting so when sorting, specify the complete parameters for example `ws.Columns(1).Sort Key1:=ws.Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal` — Siddharth Rout, Jul 21 '21 at 07:42

score 2 · Accepted Answer · answered Jul 21 '21 at 07:13

Try removing Or MemoCanc = .Cells(K, 1)

   Sub Elina_Tutti_I_Doppioni_2()
        Dim LastRow As Long, K As Long, MemoCanc As Variant
        
        Application.ScreenUpdating = False

        With ActiveSheet
            .Columns("A").Sort .[a1], Header:=xlGuess
            LastRow = [COUNTA(A:A)]
     
            For K = LastRow To 2 Step -1
                If .Cells(K, 1) = .Cells(K - 1, 1) Then
                    .Rows(K).EntireRow.Delete
                End If
            Next
        End With
      
        Application.ScreenUpdating = True
    End Sub

Eliminate one of the two duplicate values ​with a macro

1 Answers1

Eliminate one of the two duplicate values with a macro