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

[bigme]

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

 

[MD Tanvir Rahman]

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.

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

 

[bigme]

dear Rahman,
thank you very much for your help....

regards,
bigMe

 

[shamimarita]

Dear bigMe,

You are most welcome.