Sub CheckNote()
Dim Dict, SData As Range, RArr(), Sample As Range
Dim LastRw As Long, sKey As String, DataRows As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set Sample = Range("I5:K8")
For i = 1 To Sample.Rows.Count
sKey = Sample(i, 1).Interior.Color & _
"|" & Sample(i, 2).Interior.Color & _
"|" & Sample(i, 3).Interior.Color
Dict.Add sKey, i
Next
LastRw = Cells(1000, 2).End(xlUp).Row
Set SData = Range("C5:E" & LastRw)
DataRows = SData.Rows.Count
ReDim RArr(1 To DataRows, 1 To 1)
For i = 1 To DataRows
sKey = SData(i, 1).Interior.Color & _
"|" & SData(i, 2).Interior.Color & _
"|" & SData(i, 3).Interior.Color
If Dict.exists(sKey) Then RArr(i, 1) = "Yes"
Next
Range("F5:F1000").ClearContents
Range("F5").Resize(UBound(RArr, 1), 1).Value = RArr
End Sub