Match color in Columns

[IKHAN]

Hello,

Using below Macro to highlight duplicate date\time in column D- Works fine. Challenge i have is to find matching date\time in other column E and highlight with same color as column D.

Kindly Assist ...Thank You

Sub test3() ' Highlight dup times in col D
Dim r As Range, myColor, n As Long
Dim target As Range

Set target = Worksheets("TestPlan").Columns("d")
    If Intersect(target, Columns("D")) Is Nothing Then Exit Sub
    [d4].CurrentRegion.Columns(90).Offset(1).Interior.ColorIndex = xlNone
    myColor = Array(4, 6, 35, 12, 15, 37, 38, 39, 40, 41, 46, 50, 53)
    Columns(90).Interior.ColorIndex = xlNone
    ReDim Preserve myColor(1 To UBound(myColor) + 1)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In Range("D4", Range("D" & Rows.Count).End(xlUp))
            If r.Value <> "" Then
                If Not .exists(r.Value) Then
                    Set .Item(r.Value) = r
                Else
                    If TypeOf .Item(r.Value) Is Range Then
                        n = n + 1: If n > UBound(myColor) Then n = 1
                        Union(.Item(r.Value), r).Interior.ColorIndex = myColor(n)
                        .Item(r.Value) = myColor(n)
                    Else
                        r.Interior.ColorIndex = .Item(r.Value)
                    End If
                End If
            End If
        Next
    End With

End Sub

 

[Chihiro]

Something like this?

Sub test3() ' Highlight dup times in col D
Dim r As Range, myColor, n As Long
Dim target As Range

Set target = Worksheets("TestPlan").Columns("d")
    If Intersect(target, Columns("D")) Is Nothing Then Exit Sub
    [d4].CurrentRegion.Columns(90).Offset(1).Interior.ColorIndex = xlNone
    myColor = Array(4, 6, 35, 12, 15, 37, 38, 39, 40, 41, 46, 50, 53)
    Columns(90).Interior.ColorIndex = xlNone
    ReDim Preserve myColor(1 To UBound(myColor) + 1)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In Range("D4", Range("D" & Rows.Count).End(xlUp))
            If r.Value <> "" Then
                If Not .exists(r.Value) Then
                    Set .Item(r.Value) = r
                Else
                    If TypeOf .Item(r.Value) Is Range Then
                        n = n + 1: If n > UBound(myColor) Then n = 1
                        Union(.Item(r.Value), r).Interior.ColorIndex = myColor(n)
                        .Item(r.Value) = myColor(n)
                    Else
                        r.Interior.ColorIndex = .Item(r.Value)
                    End If
                End If
            End If
        Next
        For Each r In Range("E4", Range("E" & Rows.Count).End(xlUp))
            If r.Value <> "" Then
                If TypeName(.Item(r.Value)) = "Integer" Then
                    r.Interior.ColorIndex = .Item(r.Value)
                End If
            End If
        Next
    End With

End Sub

 

[IKHAN]

@Chihiro Thank You ..It works