Macro not running as originally planned

[ghrek]

Hi
brings
I had this macro that points out duplicate and missing items. It brings up the missing on sheet 1 but for some reason does not delete 1 duplicated entry on sheet 2 and then mark other as DUPLICATE in column E.

Any Ideas?

Sub DeleteIdenticalRecordsFromTwoSheets()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr1 As Long, lr2 As Long, i As Long
Dim x, y, dict1 As Object, dict2 As Object
Dim delRng1 As Range, delRng2 As Range
Dim Txt As String
Application.ScreenUpdating = False

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")

lr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row


lr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
x = ws1.Range("A1:D" & lr1).Value
y = ws2.Range("A1:D" & lr2).Value

Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
   Txt = x(i, 1) & x(i, 2) & x(i, 3) & x(i, 4)
   If Not dict1.exists(Txt) Then
      dict1.Add Txt, Array(i, 1)
   Else
      dict1(Txt) = Array(dict1(Txt)(0), dict1(Txt)(1) + 1)
   End If
Next i

For i = 1 To UBound(y, 1)
    Txt = y(i, 1) & y(i, 2) & y(i, 3) & y(i, 4)
    If Not dict2.exists(Txt) Then dict2.Add Txt, i
Next i
For i = 1 To UBound(x, 1)
   Txt = x(i, 1) & x(i, 2) & x(i, 3) & x(i, 4)
    If dict2.exists(Txt) Then
        If delRng1 Is Nothing Then
            Set delRng1 = ws1.Rows(i)
        Else
            Set delRng1 = Union(delRng1, ws1.Rows(i))
        End If
    Else
        ws1.Range("E" & i) = "Missing"
    End If
Next i


For i = 1 To UBound(y, 1)
   Txt = y(i, 1) & y(i, 2) & y(i, 3) & y(i, 4)
   If dict1.exists(Txt) Then
      If dict1(Txt)(1) = 0 Then
         ws2.Cells(i, 5) = "Duplicate"
      Else
         dict1(Txt) = Array(dict1(Txt)(0), dict1(Txt)(1) - 1)
         If delRng2 Is Nothing Then
            Set delRng2 = ws2.Rows(i)
         Else
            Set delRng2 = Union(delRng2, ws2.Rows(i))
         End If
      End If
   End If
Next i
If Not delRng1 Is Nothing Then delRng1.Delete
If Not delRng2 Is Nothing Then delRng2.Delete
End Sub