Finding out duplicate rows in excel

[Kanik]

Hi,

I have to identify duplicate rows in an excel file and throw them into a different sheet. The rows will be duplicates of each other only if all column values match . I am dealing with 16 columns so far, and they all deal with different sorts of data (text, date, etc).

example ( Order of columns is given here too)

Order: A, B,C,D,E,F,G,H,I,J,K,AA,AB,AC,AD,AE

009, 008, rigc, 4, 05/01/14, opl, fds, 002, D, p0, ow, ath, med, ipl, 0009, 08p
009, 008, rigc, 4, 05/01/14, opl, fds, 002, D, p0, ow, ath, med, ipl, 0009, 08p
009, 008, rigc, 4, 06/01/14, opl, fds, 002, D, p0, ow, ath, comm, ipl, 0009, 08p
009, 008, rigc, 4, 07/01/14, opl, fds, 002, D, p0, ow, ath, signi, ipl, 0009, 08p
009, 008, rigc, 4, 05/01/14, opl, fds, 002, D, p0, ow, ath, med, ipl, 0009, 08p

The first two rows and the last rows are all duplicates. The code must pick up all these rows and dump them in another sheet named "Errors".

I tried using following code, but it did not work, Excel is giving type mismatch error.

Sub findingduplicates()


Const TEST_COLUMN As String = "G" '
Dim i As Long
Dim iLastRow As Long
Dim rng As Range
Dim vlastrow As Long

ThisWorkbook.Activate
MBC_012014.Activate

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
If .Evaluate("SUMPRODUCT(--(A" & i & ":A" & iLastRow & "=A" & i & ")," & _
"--(B" & i & ":B" & iLastRow & "=B" & i & ")," & _
"--(C" & i & ":C" & iLastRow & "=C" & i & ")," & _
"--(D" & i & ":D" & iLastRow & "=D" & i & ")," & _
"--(E" & i & ":E" & iLastRow & "=E" & i & ")," & _
"--(F" & i & ":F" & iLastRow & "=F" & i & ")," & _
"--(G" & i & ":G" & iLastRow & "=G" & i & ")," & _
"--(H" & i & ":H" & iLastRow & "=H" & i & ")," & _
"--(I" & i & ":I" & iLastRow & "=I" & i & ")," & _
"--(J" & i & ":J" & iLastRow & "=J" & i & ")," & _
"--(K" & i & ":K" & iLastRow & "=K" & i & ")," & _
"--(AA" & i & ":AA" & iLastRow & "=AA" & i & ")," & _
"--(AB" & i & ":AB" & iLastRow & "=AB" & i & ")," & _
"--(AC" & i & ":AC" & iLastRow & "=AC" & i & ")," & _
"--(AD" & i & ":AD" & iLastRow & "=AD" & i & "))") > 1 Then

If rng Is Nothing Then
Set rng = .Rows(i)
Else
Set rng = Union(rng, .Rows(i))
End If
End If
Next i

If Not rng Is Nothing Then
rng.Select
Selection.Copy
Application.CutCopyMode = False
Windows("Errors.xlsx").Activate
Range("A" & 1).Select
ActiveSheet.Paste
End If

End With




End Sub


What is the error here?
Please help me out, I am burning out here!

 

[skorpionkz]

should code move all duplicate rows to error sheet (1,2 and last) or first should stay on current sheet?

 

[skorpionkz]

If you need to move duplicated rows only check below code. It works for 19 columns, if you need more just change "For icol = 1 To 19" (change it in both places) to "For icol = 1 To XX" where XX is number of columns on your sheet

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub findingduplicates()


Dim CurSheet, ErrSheet As Worksheet
Dim myrange1, myrange2 As String
Dim irow, xrow, LastRow, icol As Long


Set CurSheet = ActiveSheet
Set ErrSheet = Sheets("Errors")


irow = 1
Do Until Cells(irow, 1) = Empty
    myrange1 = Empty
    For icol = 1 To 19
    myrange1 = myrange1 & Cells(irow, icol)
    Next icol
        
        xrow = 2
        Do Until Cells(xrow, 1) = Empty
            If Not irow = xrow Then
                myrange2 = Empty
                For icol = 1 To 19
                myrange2 = myrange2 & Cells(xrow, icol)
                Next icol
        
                    If myrange1 = myrange2 Then
                        Rows(xrow).Copy
                        ErrSheet.Activate
                            LastRow = 1
                            Do Until Cells(LastRow, 1) = Empty
                                LastRow = LastRow + 1
                            Loop
                        Cells(LastRow, 1).Select
                        ActiveSheet.Paste
                        CurSheet.Activate
                        Rows(xrow).Delete shift:=xlUp
                        xrow = xrow - 1
                    End If
                    
            End If
        xrow = xrow + 1
        Loop
        
irow = irow + 1
Loop


End Sub