[Solved] compare rows to find duplicate and copy non duplicate to other worksheet

bigme

Member
hello,
i need help how to check each row to find duplicate, but it must identical from A to C, if one of the cells is different then it's not duplicate.
after find the duplicate data, i need to copy all the non duplicate data to other sheet (sheet2) and clear all the duplicate data in sheet1 when i close the application.
thank you for the help.

regards,
bigMe
Capture.JPG
 
Dear valued user, Thank you for your queries. Use the following code and please follow the instruction properly. Let me know, about your further shortcomings.

3.png

Code:
Sub copy_non_duplicate_rows()
Dim Rng As Range, i As Long, j As Long
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim newRow As Long
 
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsDestination = ThisWorkbook.Worksheets.Add     'Add worksheet
Set Rng = wsSource.Range("A1:C7")   'Define your range
newRow = 1    'Assign value to use as row futher
 
For i = 2 To Rng.Rows.Count     'Loop to judge each value
    Dim isDuplicate As Boolean
    isDuplicate = False        'At first consider there is no duplicate
    For j = 1 To i - 1      'Within this loop, we will judge based on condition
        If wsSource.Cells(i, 1).Value = wsSource.Cells(j, 1).Value And _
            wsSource.Cells(i, 2).Value = wsSource.Cells(j, 2).Value And _
            wsSource.Cells(i, 3).Value = wsSource.Cells(j, 3).Value Then
            isDuplicate = True    'If it meet the condition then it is duplicate
            Exit For        'Escape from the Loop
        End If
    Next j

    If Not isDuplicate Then     'If no duplicate is found then copy data to Sheet2
        Rng.Rows(i).Copy wsDestination.Cells(newRow, 1)
        newRow = newRow + 1
        End If
    Next i
End Sub
 
Last edited:

Online statistics

Members online
0
Guests online
11
Total visitors
11

Forum statistics

Threads
311
Messages
1,378
Members
568
Latest member
WilliamHon
Top