Sub DeleteDuplicateOrangeX()
'Compare columns G,L,M & W for duplicated rows, delete the ones that
'are duplicates AND have an orange color in column X
Dim LR As Long, Rng As Range, Cell As Range
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
'Create key columns to evaluate columns of data
Range("CC5:CC" & LR).FormulaR1C1 = "=RC7&""-""&RC12&""-""&RC13&""-""&RC23"
Range("CD5:CE" & LR).FormulaR1C1 = "=COUNTIF(C81,RC81)>1"
Range("CC5:CE" & LR).Value = Range("CC5:CE" & LR).Value
Range("CD3") = "key"
'Autofilter duplicated rows
Range("CD3:CE" & LR).AutoFilter Field:=1, Criteria1:=True
'Set Rng = Range("CD5:CE" & LR).SpecialCells(xlCellTypeVisible)
On Error Resume Next
Set Rng = Range("CD5:CE" & LR).SpecialCells(xlCellTypeVisible)
If Err <> 0 Then
ActiveSheet.AutoFilterMode = False
Range("CC:CE").ClearContents
Rows(4).Hidden = True
Application.ScreenUpdating = True
Exit Sub
Else
'Flag duplicates with orange "X" columns
For Each Cell In Rng
If Cells(Cell.Row, "X").Interior.ColorIndex = 44 Then Cell = 1
Next Cell
'Refilter by flagged rows and delete
Range("CD3:CE" & LR).AutoFilter Field:=1, Criteria1:=1
If Range("CE" & Rows.Count).End(xlUp).Row > 4 Then _
Range("A5:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlShiftUp
'Cleanup
ActiveSheet.AutoFilterMode = False
Range("CC:CE").ClearContents
Rows(4).Hidden = True
Application.ScreenUpdating = True
End If
On Error GoTo 0
End Sub
