Excel macro - duplication in two lists

Hey guys,

I am absolutely new to excel programming, so I would appreciate a little help with my program. I have two lists with datas, both has a column with emails (simply text). I need need to compare those two columns, and if there is a duplicate email in the second list (List2), delete the whole row with the email. To sum it up, each time I need to compare one email from the List1 to plenty of emails from the List2 (that is why I chose 2 for cycles).

Here is my work, but it does not work at all (there is probably a syntax error in the IF statement).

Sub nahrada()

    For I = 0 To Rows.Count
      For J = 1 To Worksheets("List2").Rows.Count 
        IF (Range(Cells(I,6)).Text = Worksheets("List2").Range(Cells(J,3)).Text) Then
          Worksheets("List2").Rows(J).Delete
        End If    
      Next J
    Next I
End Sub

Thanks a lot for your help, I really appreciate it

Untested but give this a try

Sub nahrada()
 Dim FoundCell As Range
 Dim LastCell As Range
 Dim RangeToDelete As Range
 Dim FirstAddr As String
 Dim LastRow As Long
    
    With Worksheets("List2")
        For ptr = 1 To ActiveSheet.Cells(Rows.CountLarge, "F").End(xlUp).Row
            LastRow = .Cells(Rows.CountLarge, 1).End(xlUp).Row
            With .Range("J1:J" & LastRow)
                Set LastCell = .Cells(.Cells.Count)
            End With
            Set FoundCell = .Range("J1:J" & LastRow).Find(What:=ActiveSheet.Cells(ptr, "F"), After:=LastCell)
            
            If Not FoundCell Is Nothing Then
                FirstAddr = FoundCell.Address
            End If
            Do Until FoundCell Is Nothing
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells(FoundCell.Row, "A")
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells(FoundCell.Row, "A"))
                End If
                Set FoundCell = .Range("J1:J" & LastRow).FindNext(After:=FoundCell)
                If FoundCell.Address = FirstAddr Then
                    Exit Do
                End If
            Loop
            If Not RangeToDelete Is Nothing Then
                RangeToDelete.EntireRow.Delete
            End If
            Set RangeToDelete = Nothing
        Next
    End With
End Sub

Can u upload a sample workbook

Try this

Sub nahrada()
 Dim FoundCell As Range
 Dim LastCell As Range
 Dim RangeToDelete As Range
 Dim FirstAddr As String
 Dim LastRow As Long
    
    With Worksheets("List2")
        LastRow = .Cells(Rows.CountLarge, 1).End(xlUp).Row
        For ptr = 1 To Worksheets("List1").Cells(Rows.CountLarge, "F").End(xlUp).Row
            With .Range("C2:C" & LastRow)
                Set LastCell = .Cells(.Cells.Count)
            End With
            Set FoundCell = .Range("C2:C" & LastRow).Find(What:=Worksheets("List1").Cells(ptr, "F"), After:=LastCell)
            
            If Not FoundCell Is Nothing Then
                FirstAddr = FoundCell.Address
            End If
            Do Until FoundCell Is Nothing
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells(FoundCell.Row, "A")
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells(FoundCell.Row, "A"))
                End If
                Set FoundCell = .Range("C2:C" & LastRow).FindNext(After:=FoundCell)
                If FoundCell.Address = FirstAddr Then
                    Exit Do
                End If
            Loop
        Next
    End With
    If Not RangeToDelete Is Nothing Then
        RangeToDelete.EntireRow.Delete
    End If
    Set RangeToDelete = Nothing
End Sub

This should fix you up

Sub nahrada()
 Dim FoundCell As Range
 Dim LastCell As Range
 Dim RangeToDelete As Range
 Dim FirstAddr As String
 Dim LastRow As Long
    
    With Worksheets("List2")
        LastRow = .Cells(Rows.CountLarge, "C").End(xlUp).Row
        For ptr = 1 To Worksheets("List1").Cells(Rows.CountLarge, "F").End(xlUp).Row
            With .Range("C2:C" & LastRow)
                Set LastCell = .Cells(.Cells.Count)
            End With
            Set FoundCell = .Range("C2:C" & LastRow).Find(What:=Worksheets("List1").Cells(ptr, "F"), After:=LastCell)
            
            If Not FoundCell Is Nothing Then
                FirstAddr = FoundCell.Address
            End If
            Do Until FoundCell Is Nothing
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells(FoundCell.Row, "C")
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells(FoundCell.Row, "C"))
                End If
                Set FoundCell = .Range("C2:C" & LastRow).FindNext(After:=FoundCell)
                If FoundCell.Address = FirstAddr Then
                    Exit Do
                End If
            Loop
        Next
    End With
    If Not RangeToDelete Is Nothing Then
        RangeToDelete.EntireRow.Delete
    End If
    Set RangeToDelete = Nothing
End Sub