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

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
912
Office Version
2016
Platform
Windows
Hi,

I am using this VBA code to filter records.

Code:
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
 

Some videos you may like

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
This is untested:
Make sure you type just comma (without space) between the items e.g "Tony,Smith".
Code:
[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.
 
Last edited:

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
912
Office Version
2016
Platform
Windows
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

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
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:

Code:
[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

Well-known Member
Joined
Jul 23, 2010
Messages
912
Office Version
2016
Platform
Windows
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

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
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

Well-known Member
Joined
Jul 23, 2010
Messages
912
Office Version
2016
Platform
Windows
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

Code:
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 ??

Code:
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.

Code:
[/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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,941
Office Version
365
Platform
Windows
How many criteria are you likely to put in one of those cells?
 

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
912
Office Version
2016
Platform
Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,840
Messages
5,489,196
Members
407,677
Latest member
Matt1989

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top