Hi
I've edited the code by adding a variable (x) which increments each loop to determine which row to delete.
Please let me know how it goes
Sub Duplicates()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim cell1 As Range, cell2 As Range, cell3 As Range, cell4 As Range
Dim x As Long
Set rng1 = Worksheets("Archive").Range("$B:$B")
Set rng2 = Worksheets("Agents").Range("J26:J1000")
Set rng3 = Worksheets("Archive").Range("$A:$A")
Set rng4 = Worksheets("Agents").Range("E26:E1000")
For Each cell1 In rng1
x = cell1.Row
If IsEmpty(cell1.Value) Then Exit For
For Each cell2 In rng2
If IsEmpty(cell2.Value) Then Exit For
If cell1.Value = cell2.Value Then
cell1.Interior.ColorIndex = 4
cell1.Interior.Pattern = xlSolid
cell2.Interior.ColorIndex = 4
cell2.Interior.Pattern = xlSolid
cell2.EntireRow.Resize(, 14).Interior.ColorIndex = 4
End If
Next cell2
Next cell1
For Each cell3 In rng3
If IsEmpty(cell3.Value) Then Exit For
For Each cell4 In rng4
If IsEmpty(cell4.Value) Then Exit For
If cell3.Value = cell4.Value Then
cell3.Interior.ColorIndex = 5
cell3.Interior.Pattern = xlSolid
cell4.Font.ColorIndex = 5
cell4.Borders.Weight = xlThick
cell4.EntireRow.Resize(, 14).Interior.ColorIndex = 4
End If
Next cell4
Next cell3
x = x - 1
If cell1.Value = cell2.Value And cell3.Value = cell4.Value Then
Sheets("Archive").Rows(x & ":" & x).Delete
End If
End Sub
Bookmarks