remove duplicates from sheet2

[hsolanki]

Hi everyone i have an code whereby it will loop between the sheet2 and sheet3 and look for duplicate from sheet3 to sheet2 whereby both sheets have 3 columns. it is currently not working and it will not delete the duplicates from sheet 2 after looping into sheet3.

Sub RemoveDuplicateRows()
    Dim ur1 As Range, ur2 As Range, dupeRows As Range
    Dim r1 As Range, s1 As String, r2 As Range, s2 As String
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    

    Set ur1 = Worksheets("EmailsSent").UsedRange.Rows
    Set ur2 = Worksheets("EmailReport").UsedRange.Rows  'Find duplicates from Sheet1 in Sheet2
    
    Sheet2.Unprotect Password:="2020"

    Set dupeRows = ur2(Worksheets("EmailReport").UsedRange.Rows.Count + 1)
    For Each r1 In ur1
        s1 = Join(Application.Transpose(Application.Transpose(r1)))
        For Each r2 In ur2
            s2 = Join(Application.Transpose(Application.Transpose(r2)))
            If s1 = s2 Then
                If Intersect(dupeRows, r2) Is Nothing Then
                    Set dupeRows = Union(dupeRows, r2)
                End If
            End If
        Next
    Next

    dupeRows.EntireRow.Delete
    Sheet2.Protect Password:="2020"
     Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[hsolanki]

Hi Fluff You are a star. it worked. Thank you once again for all your help ?

 

[Fluff]

You're welcome & thanks for the feedback.