Sub Testfiler()
Dim arr(), lngRows As Long, selRng As Range, i As Long
Set selRng = Selection
ReDim arr(1000)
ActiveSheet.Range("$A$1:$C$1").AutoFilter Field:=5
lngRows = ActiveSheet.AutoFilter.Range.Rows.Count
For Each c1 In Range("E2:E" & lngRows)
For Each c2 In selRng
If c1 Like "*" & c2 & "*" Then
arr(i) = c1
i = i + 1
If i Mod 1000 = 0 Then ReDim Preserve arr(i + 1000)
End If
Next c2
Next c1
ReDim Preserve arr(i)
ActiveSheet.Range("A1:Q1").AutoFilter Field:=5, Criteria1:=arr, Operator:=xlFilterValues
End Sub