VBA find duplicates and move to another sheet

[Darkcloud617]

Hello,

We have a code that searches 3 columns for criteria and if a duplicate is found it moves the duplicates to another sheet and deletes the row on the original. The problem is that it does not leave one of the rows on the original sheet. It moves all duplicates to the other sheet, wondering if anyone may know how to alter the code to leave one on the original sheet:

Sub RemoveDuplicatesCLick()

    Dim lastrow As Long, lastcolumn As Long, rng As Range
  
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
  
    Application.ScreenUpdating = False
  
    'Change sheet where your list is (sheet number must match. You can find sheet number on left of VBA editor)
    With Sheet10
        Set rng = .Range("A1", .Cells(lastrow, lastcolumn))
        .AutoFilterMode = False
      
    'Change wildcard options below (columns chosen for duplicate search): C2&E2&H2
        .Range("A2").Formula = "=C2&E2&H2"
        .Range("A2").AutoFill Destination:=.Range("A2:A" & lastrow)
      
        .Range("B2").Formula = "=COUNTIF($A$2:$A$" & lastrow & ",A2)"
        .Range("B2").AutoFill Destination:=.Range("B2:B" & lastrow)
      
        rng.AutoFilter field:=2, Criteria1:=">1"
      
    'Change "Sheet5" to the sheet you want to export on.
      
        rng.Offset(1, 0).SpecialCells(12).Copy Destination:=Sheet11.Range("A1")
'this is the area that needs to be altered to leave one of the duplicates on the original sheet
        rng.Offset(1, 0).EntireRow.Delete
        Columns("C:w").ClearContents
        .AutoFilterMode = False
      
      
    End With
  
    Set rng = Nothing

    Application.ScreenUpdating = True


End Sub

Thank you in advance for any assistance or thoughts.

Edit: I put a note in the VBA code to show where the area is that needs to leave one of the rows on the original sheet towards the bottom.

 

[Max1616]

Instead of changing the part you commented, what if you changed your formula to show a 1 for the first time something shows up in your data set?
Change this:

.Range("B2").Formula = "=COUNTIF($A$2:$A$" & lastrow & ",A2)"

To this:

.Range("B2").Formula = "=COUNTIF($A$2:$A2,A2)"

 

[Darkcloud617]

Brilliant idea. I added a new helper column to flag the first variable in the list and it worked. Thank you.