Hi,

Try this macro.

Code:
Option Explicit

Sub kTest()
    
    Dim d, r As Long, c As Long, n As Long, Rng As Range
    Dim dic As Object, a() As String, x, y, Colors, j As Long
    
    Set Rng = Range("a1:j12")                   '<<< adjust the range
    d = Rng.Value2
    
    Colors = Array(255, 65535, 52479, 8388736)  '<<< add as many as interior colors
    
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    x = Application.Index(d, 0, 1)
    n = -1
    For r = 1 To UBound(d, 1)
        For c = 3 To UBound(d, 2) Step 2
            If Len(d(r, c)) Then
                y = Application.Match(d(r, c), x, 0)
                If IsError(y) Then
                    If Not dic.exists(d(r, c)) Then
                        n = n + 1: dic.Item(d(r, c)) = Colors(n)
                        j = j + 1: ReDim Preserve a(1 To j)
                        a(j) = Rng.Cells(r, c + 1).Address & "|" & Colors(n)
                    Else
                        j = j + 1: ReDim Preserve a(1 To j)
                        a(j) = Rng.Cells(r, c + 1).Address & "|" & dic.Item(d(r, c))
                    End If
                End If
            End If
        Next
    Next
    
    x = Array(dic.keys, dic.items)
    
    With Rng
        For r = 0 To UBound(x(0))
            Application.ReplaceFormat.Interior.Color = x(1)(r)
            .Replace What:=x(0)(r), Replacement:=x(0)(r), LookAt:=xlWhole, ReplaceFormat:=True
        Next
        For r = 1 To j
            y = Split(a(r), "|")
            .Range(y(0)).Interior.Color = y(1)
        Next
    End With

End Sub