Sub a()
Dim Arr
Arr = Array(1, 2, 3, 4)
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim i As Integer
For i = LBound(Arr) To UBound(Arr)
d(Arr(i)) = ""
Next i
Dim R As Long
R = Sheet1.Cells(65536, 1).End(xlUp).Row
Dim x As Long
Dim y
For x = 1 To R
y = Sheet1.Cells(x, 1)
If d.Exists(y) Then Sheet1.Cells(x, 2) = 1
Next x
Set d = Nothing
End Sub