VBA Filter codes needs amendment to filter values which are seperated with a comma

[hrayani]

Hi,

I am using this VBA code to filter records.

Private Sub Worksheet_Change(ByVal Target As Range) 
 Application.ScreenUpdating = False
    
    With ActiveSheet.Range("D5:F1000")
    .AutoFilter
    .AutoFilter Field:=1, Criteria1:="*" & Range("D4") & "*", visibledropdown:=False
    .AutoFilter Field:=2, Criteria1:="*" & Range("E4") & "*", visibledropdown:=False
    .AutoFilter Field:=3, Criteria1:="*" & Range("F4") & "*", visibledropdown:=False
    End With
    
    Application.ScreenUpdating = True


End Sub

Here is what i require:

If I enter (Tony, Smith) in cell D4 then the code should filter both records for tony & smith.

As of now the code only allows me to enter a single criteria in cells D4:F4

I would want the code to allow me to enter multiple criteria entered with a comma sign.

Any help would be appreciated

Regards,

Humayun

 

[Akuini]

This is untested:
Make sure you type just comma (without space) between the items e.g "Tony,Smith".

[FONT=lucida console]Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
    arr = Split(Range([COLOR=brown]"D4"[/COLOR]), [COLOR=brown]","[/COLOR])
    [COLOR=Royalblue]With[/COLOR] ActiveSheet.Range([COLOR=brown]"D5:F1000"[/COLOR])
    .AutoFilter
    .AutoFilter Field:=[COLOR=crimson]1[/COLOR], Criteria1:=arr, [COLOR=Royalblue]Operator[/COLOR]:=xlFilterValues, visibledropdown:=[COLOR=Royalblue]False[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
    
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[/FONT]

Note:
You use Private Sub Worksheet_Change
I think you should limit the event to cell D4, otherwise it will be triggered on any cell's change.

 

[hrayani]

Thanks Akuini,

Code you provided is working perfect. Can u amend it so that it can work for all columns D, E & F..

Make sure you type just comma (without space) between the items e.g "Tony,Smith"

Well i tried with space and its working fine.

 

[Akuini]

Thanks Akuini,

Code you provided is working perfect. Can u amend it so that it can work for all columns D, E & F..

Try this:

[FONT=lucida console]Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]

arr1 = Split(Range([COLOR=brown]"D4"[/COLOR]), [COLOR=brown]","[/COLOR])
arr2 = Split(Range([COLOR=brown]"E4"[/COLOR]), [COLOR=brown]","[/COLOR])
arr3 = Split(Range([COLOR=brown]"F4"[/COLOR]), [COLOR=brown]","[/COLOR])

    
    [COLOR=Royalblue]With[/COLOR] ActiveSheet.Range([COLOR=brown]"D5:F1000"[/COLOR])
    .AutoFilter
    [COLOR=Royalblue]On[/COLOR] [COLOR=Royalblue]Error[/COLOR] [COLOR=Royalblue]Resume[/COLOR] [COLOR=Royalblue]Next[/COLOR]
    .AutoFilter Field:=[COLOR=crimson]1[/COLOR], Criteria1:=arr1, [COLOR=Royalblue]Operator[/COLOR]:=xlFilterValues, visibledropdown:=[COLOR=Royalblue]False[/COLOR]
    .AutoFilter Field:=[COLOR=crimson]2[/COLOR], Criteria1:=arr2, [COLOR=Royalblue]Operator[/COLOR]:=xlFilterValues, visibledropdown:=[COLOR=Royalblue]False[/COLOR]
    .AutoFilter Field:=[COLOR=crimson]3[/COLOR], Criteria1:=arr3, [COLOR=Royalblue]Operator[/COLOR]:=xlFilterValues, visibledropdown:=[COLOR=Royalblue]False[/COLOR]
    [COLOR=Royalblue]On[/COLOR] [COLOR=Royalblue]Error[/COLOR] [COLOR=Royalblue]GoTo[/COLOR] [COLOR=crimson]0[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
    
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR][/FONT]

 

[hrayani]

Working Perfect...

few minor issues..

1) The code i was using was working with the contains part of filter.. Like Ton for Tony, Sm for Smith. I did not had to enter full name.
2) When i press delete on a blank cell then all the cells shows filter arrows.

Any Idea ??

 

[Akuini]

1) The code i was using was working with the contains part of filter.. Like Ton for Tony, Sm for Smith. I did not had to enter full name.

Sorry, don't know how to do that, but you can use * like sm* or *mi* & it's case insensitive.

2) When i press delete on a blank cell then all the cells shows filter arrows.

You use Private Sub Worksheet_Change
I think you should limit the event to cell D4,E4,F4, otherwise it will be triggered on any cell's change.

 

[hrayani]

Sorry, don't know how to do that, but you can use * like sm* or *mi* & it's case insensitive.

I tried to experiment a bit myself. Came up with this

Split("*" & Range("D4") & "*", ",")

but its behaving a bit weird.

Examples

1) Enter a single criteria... no issues. "To" or "on" or "ny"... all is fine for Tony
2) Enter multiple criteria.... Like for Tony & Smith. Then I will have to enter it this way for perfect filter. "ny, Sm". Last part of the 1st criteria & First part of the 2nd criteria. Otherwise it will not filter...

Any idea how to make further changes to make it work in a manner so that it can filter if any part of the name is entered ??

Split("*" & Range("D4") & "*", ",")

You use Private Sub Worksheet_Change
I think you should limit the event to cell D4,E4,F4, otherwise it will be triggered on any cell's change.

Yes i did that.

[/COLOR]Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("D4, E4, F4")) Is Nothing Then




Application.ScreenUpdating = False


arr1 = Split("*" & Range("D4") & "*", ",")
arr2 = Split(Range("E4"), ",")
arr3 = Split(Range("F4"), ",")


    
    With ActiveSheet.Range("D5:F1000")
    .AutoFilter
    On Error Resume Next
    .AutoFilter Field:=1, Criteria1:=arr1, Operator:=xlFilterValues, visibledropdown:=False
    .AutoFilter Field:=2, Criteria1:=arr2, Operator:=xlFilterValues, visibledropdown:=False
    .AutoFilter Field:=3, Criteria1:=arr3, Operator:=xlFilterValues, visibledropdown:=False
    On Error GoTo 0
    End With
    
Application.ScreenUpdating = True


End If


End Sub


[COLOR=#333333]

But even if i press delete on any of these 3 cells then filter arrow shows on these 3 columns.

 

[Fluff]

How many criteria are you likely to put in one of those cells?

 

[hrayani]

Hi Fluff,

How many criteria are you likely to put in one of those cells?

Not sure at this point of time. May be 8 I guess.

Actually as of now I have like 15 different names in there which will grow upto 25 in future I reckon.
So if the code allows me to enter as many as I want then I will also be able to use the filter if I want all the records excluding one or two names - like what we do in filter (does not contain)

Regards,

Humayun

 

[Fluff]

In that case you will need to look at advanced filters. https://www.contextures.com/xladvfilter01.html

Autofilters can only filter on 2 values if you want to use "contains"