Change background color of duplicate, clear duplicates & leave background color changed

Hi,

I am seeking a VBA that will change the background color orange of the duplicates and clear the duplicates, but I seek for the background color to remain changed to orange. The purpose is to track that a defect had multiple issues on one piece with the orange color, but not double, triple count the issues that occurred on one part as multiple different occurrences for a different report. I thought about conditional formatting, but wasn't sure how to keep the background the same color, after the duplicate is removed.

1. Find duplicate rows with matching information of Date, Shift, Broadcast, and Duon Location.
2. If there is a duplicate with that information, I seek to change the Duon Location cell background color "Orange" of the duplicates.
3. Clear the value of the duplicate from A:L.
4. Leave the remaining row of data with an Orange background in the Duon Location cell.

Thank you for any help or guidance in this process.

Try this

Sub checkduplicates()

Dim rownum, nextrow As Integer

rownum = 2

Do While Range("N" & rownum).Value <> ""
    nextrow = rownum + 1
    
    Do While Range("N" & nextrow).Value <> ""
        If Range("A" & rownum).Value = Range("A" & nextrow).Value And Range("B" & rownum).Value = Range("B" & nextrow).Value And Range("C" & rownum).Value = Range("C" & nextrow).Value And Range("I" & rownum).Value = Range("I" & nextrow).Value Then
        
            Range("A" & nextrow & ":L" & nextrow).Clear
            Range("A" & nextrow & ":L" & nextrow).Interior.ThemeColor = xlThemeColorAccent2
        
        End If
        nextrow = nextrow + 1
    Loop
    rownum = rownum + 1
Loop


End Sub

Try:

PHP Code: 

Option Explicit
Sub clearDup()
Dim lr&, i&, j&, rng, id As String
Dim dic As Object, item, s
Set dic = CreateObject("Scripting.dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:I" & lr).Value
For i = 1 To UBound(rng)
    id = rng(i, 1) & "|" & rng(i, 2) & "|" & rng(i, 3) & "|" & rng(i, 9) 'id = combine 4 key columns
    If Not dic.exists(id) Then
        dic.Add id, i + 1
    Else
        dic(id) = dic(id) & "-" & i + 1 ' store the row#
    End If
Next
For Each item In dic.items
    If InStr(1, item, "-") Then
        s = Split(item, "-")
        For i = 0 To UBound(s)
            With Cells(s(i), "A")
                .Resize(1, 12).ClearContents
                .Offset(, 8).Interior.ColorIndex = 40 ' orange color index = 40
            End With
        Next
    End If
Next
End Sub 


just change this row then

from

Range("A" & nextrow & ":L" & nextrow).Interior.ThemeColor = xlThemeColorAccent2

to

Range("I" & nextrow).Interior.ThemeColor = xlThemeColorAccent2

OK. In your original post you said you wanted the cells cleared from Columns A to L. This is column I so falls in the middle. Do you want columns A to H cleared and then J to L cleared? If so use this macro.

Sub checkduplicates()

Dim rownum, nextrow As Integer

rownum = 2

Do While Range("N" & rownum).Value <> ""
    nextrow = rownum + 1
    
    Do While Range("N" & nextrow).Value <> ""
        If Range("A" & rownum).Value = Range("A" & nextrow).Value And Range("B" & rownum).Value = Range("B" & nextrow).Value And Range("C" & rownum).Value = Range("C" & nextrow).Value And Range("I" & rownum).Value = Range("I" & nextrow).Value Then
        
            Range("A" & nextrow & ":H" & nextrow).Clear
            Range("J" & nextrow & ":L" & nextrow).Clear
            Range("I" & nextrow).Interior.ThemeColor = xlThemeColorAccent2
        
        End If
        nextrow = nextrow + 1
    Loop
    rownum = rownum + 1
Loop


End Sub

Got it. Thanks.

Change this

 Range("A" & nextrow & ":H" & nextrow).Clear
            Range("J" & nextrow & ":L" & nextrow).Clear
            Range("I" & nextrow).Interior.ThemeColor = xlThemeColorAccent2

to this

 Range("A" & nextrow & ":L" & nextrow).Clear
            Range("I" & rownum).Interior.ThemeColor = xlThemeColorAccent2

and let me know if that does the trick

No problems. We got there in the end. Thanks for the Rep too.