CODEWITHSUNDEEP
excelvba
khaloo04
khaloo04

Reputation: 1

Find duplicates in column A, copy row and delete it

This shouldn't be complicated code, but I am new to Excel VBA. I've tried many different methods resulting in bugs, infinite loops, and wrong selections.

I developed a little code which finds the duplicates in the column A and deletes one of the duplicates.

  Sub Statistique()
  Dim LastRow As Long
  Set x = ActiveWorkbook.Sheets("COPYRIGHT")
  LastRow = Range("A65536").End(xlUp).Row
  For x = LastRow To 3 Step -1
 If Application.WorksheetFunction.CountIf(Range("A3:A" & x), Range("A" & x).Text) > 1 Then
                        Range("A" & x).EntireRow.Delete
                    End If
               Next x

Now I want to improve the code, by copying the non-blank cells of the row I want to delete and paste them in the row which will remain. It means that I want the non-blank cells to be copied upper, on the first duplicate row, in the same column they were before.

Any idea?

Upvotes: 0

Views: 107

Answers (1)

Jur Pertin
Jur Pertin

Reputation: 564

Try this:

Sub Statistique()

    Dim rngColA As Range

    Set rngColA = Worksheets("COPYRIGHT").Range("A1").EntireColumn
    rngColA.RemoveDuplicates 1, xlGuess

End Sub

or 

Sub Statistique2()

    Dim rngColA As Range

    Set rngColA = Worksheets("COPYRIGHT").Cells
    rngColA.RemoveDuplicates 1, xlGuess

End Sub

Upvotes: 1

Related Questions