Sub
MultiContainsAutofilter()
Dim
vData
Dim
shData
As
Worksheet
Dim
d
As
Object
Dim
i
As
Long
Set
shData = ActiveSheet
vData = shData.UsedRange.Columns(6)
Set
d = CreateObject(
"Scripting.Dictionary"
)
For
i = LBound(vData, 1)
To
UBound(vData, 1)
If
(vData(i, 1))
Like
"*Erste*"
Or
(vData(i, 1))
Like
"*B*"
Or
(vData(i, 1))
Like
"*C*"
Then
d(vData(i, 1)) = Empty
End
If
Next
i
If
d.Count > 0
Then
shData.UsedRange.AutoFilter Field:=6, Criteria1:=d.keys, Operator:=xlFilterValues
End
Sub