Sub FilterData()
Dim cl As Range
With CreateObject("scripting.dictionary")
For Each cl In Range("B2", Range("B" & Rows.count).End(xlUp))
.Item(cl.Value) = Empty
Next cl
For Each cl In Sheets("sheet2").Range("A5:A40")
If .exists(cl.Value) Then .Remove cl.Value
Next cl
Range("B:B").AutoFilter 1, .keys, xlFilterValues
End With
End Sub