Facing problem in a Macro which compares 2 columns having comma separated / single values

Try,

Option Explicit
Sub ertert_Updated()
Dim s$, sp, x, i&, j&, k&, y, LR&
s = Join(Application.Transpose(Range("A2", Cells(Rows.Count, 1).End(xlUp))), ",")
x = Range("C2", Cells(Rows.Count, 3).End(xlUp)).Value
For i = 1 To UBound(x)
    If Len(x(i, 1)) Then
        sp = Split(x(i, 1), ",")
        k = 0
        For j = 0 To UBound(sp)
            If InStr(s, Trim(sp(j))) = 0 Then k = k + 1
        Next j
    If k > 1 Then
        x(i, 1) = 1
    Else
    x(i, 1) = k
    End If
    
    End If
Next i
Range("E2").Resize(i - 1).Value = x

  LR = Range("D" & Rows.Count).End(xlUp).Row
   If LR <= 1 Then Exit Sub
  y = Range("D1:D" & LR)
For i = 2 To UBound(y)
    If Len(y(i, 1)) Then
        sp = Split(y(i, 1), ",")
        k = 0
        For j = 0 To UBound(sp)
            If InStr(s, Trim(sp(j))) = 0 Then k = k + 1
        Next j
    If k > 1 Then
        y(i, 1) = 1
    Else
    y(i, 1) = k
    End If
    
    End If
Next i
Range("F2").Resize(i - 1).Value = y

End Sub

Hello AB33,

Thanks for the wonderful solution.