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

[Ajaxs87]

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.

[Crooza]

Try this

Please Login or Register  to view this content.

[bebo021999]

Try:

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  

[Ajaxs87]

Try this

Please Login or Register  to view this content.

Thank you! This is very close to the outcome I am seeking,

I was seeking for the duplicate that wasn't cleared out to have the orange in the background, but just in the cell in column [Duon Location]. You are awesome! I attached an image for reference of the outcome I am seeking.


@bebo021999 I couldn't get the vba to work. It wasn't showing up in my macros list when I copied and pasted it into a module. Thank you for your time and energy in this code

[Crooza]

just change this row then

from

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

to

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

[Ajaxs87]

just change this row then

from

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

to

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

Thank you for your continued support, this is the outcome I was getting when I altered the code as suggested, it is still highlighting the cell in the row with the data cleared out. I seek for it to show orange of the duplicate that remains with data in the row.

[Crooza]

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.

Please Login or Register  to view this content.

[Ajaxs87]

My apologizes for my lack of wording.

So in the original post, row 4 and row 8, have the same data in columns A,B,C & I.

- I seek for row 8 to be cleared from A:L, as it is a duplicate and effects how we score the total.

- I seek for row 4, to have the background color changed to orange in column I, to inform the reader that there was a duplicate with that information. As the root cause for the duplicate is a specific thing that , we want to take notes of.

- Currently, it clears row 8 and highlights column I in row 8 as well. Which doesn't allow me to link the duplicate to any data, as it has been cleared out.

I apologize once again, if I am not wording my request correctly.

[Crooza]

Got it. Thanks.

Change this

Please Login or Register  to view this content.

to this

Please Login or Register  to view this content.

and let me know if that does the trick

[Ajaxs87]

Got it. Thanks.

Change this

Please Login or Register  to view this content.

to this

Please Login or Register  to view this content.

and let me know if that does the trick

Thank you Crooza! I am grateful for your time, knowledge and patience

[Crooza]

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