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

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,475
Office Version
  1. 2016
Platform
  1. 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
 
Hi Akuini,

Many Thanks for the code you provided. It made my life much easier :)

Two things i would request you to add in the code.

1) I want row # 2 default height to be 35 if there is no criteria.
2) If there is any criteria then row height should be autofit.

Regards,

Humayun
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Private[/COLOR] [COLOR=Royalblue]Const[/COLOR] SRA [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR] = [COLOR=brown]"A2:E2"[/COLOR] [I][COLOR=seagreen]'address  where you type the search criteria[/COLOR][/I]
[COLOR=Royalblue]Private[/COLOR] [COLOR=Royalblue]Const[/COLOR] dS [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR] = [COLOR=crimson]2[/COLOR]  [I][COLOR=seagreen]'row where you type the search criteria[/COLOR][/I]
[COLOR=Royalblue]Private[/COLOR] [COLOR=Royalblue]Const[/COLOR] dr [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR] = [COLOR=crimson]4[/COLOR]  [I][COLOR=seagreen]'First row of data (exclude header)[/COLOR][/I]

[COLOR=Royalblue]Private[/COLOR] [COLOR=Royalblue]Sub[/COLOR] Worksheet_Change([COLOR=Royalblue]ByVal[/COLOR] Target [COLOR=Royalblue]As[/COLOR] Range)
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] m [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], p [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] r [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] arr, z, x

[COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] Intersect(Target, Range(SRA)) [COLOR=Royalblue]Is[/COLOR] [COLOR=Royalblue]Nothing[/COLOR] [COLOR=Royalblue]Then[/COLOR]
    n = Range(SRA).Resize([COLOR=crimson]100000[/COLOR]).Find([COLOR=brown]"*"[/COLOR], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
            Range([COLOR=brown]"A"[/COLOR] & dr & [COLOR=brown]":A"[/COLOR] & n).EntireRow.Hidden = [COLOR=Royalblue]False[/COLOR]

    [COLOR=Royalblue]If[/COLOR] WorksheetFunction.CountA(Range(SRA)) > [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        Rows(dS).AutoFit
        [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] r [COLOR=Royalblue]In[/COLOR] Range(SRA)
        j = r.Column
            [COLOR=Royalblue]If[/COLOR] Len(Cells(dS, j)) > [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
                arr = Split(Cells(dS, j), [COLOR=brown]","[/COLOR])
                [COLOR=Royalblue]For[/COLOR] i = dr [COLOR=Royalblue]To[/COLOR] n
                    z = Cells(i, j)
                        [COLOR=Royalblue]If[/COLOR] z = [COLOR=brown]""[/COLOR] [COLOR=Royalblue]Then[/COLOR] Rows(i).EntireRow.Hidden = [COLOR=Royalblue]True[/COLOR]
                   [COLOR=Royalblue]If[/COLOR] Rows(i).RowHeight > [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
                           m = [COLOR=crimson]0[/COLOR]
                       [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x [COLOR=Royalblue]In[/COLOR] arr
                            m = m + InStr([COLOR=crimson]1[/COLOR], z, x, [COLOR=crimson]1[/COLOR])
                            [COLOR=Royalblue]If[/COLOR] m > [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
                       [COLOR=Royalblue]Next[/COLOR]
                           [COLOR=Royalblue]If[/COLOR] m = [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR] Rows(i).EntireRow.Hidden = [COLOR=Royalblue]True[/COLOR]
                   [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
                [COLOR=Royalblue]Next[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
        [COLOR=Royalblue]Next[/COLOR]
        
    [COLOR=Royalblue]Else[/COLOR]
            Rows(dS).RowHeight = [COLOR=crimson]35[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]On[/COLOR] [COLOR=Royalblue]Error[/COLOR] [COLOR=Royalblue]Resume[/COLOR] [COLOR=Royalblue]Next[/COLOR]
p = Range([COLOR=brown]"A"[/COLOR] & dr & [COLOR=brown]":A"[/COLOR] & n).SpecialCells(xlCellTypeVisible).Cells.Count
Application.StatusBar = [COLOR=brown]"Found "[/COLOR] & p & [COLOR=brown]" rows"[/COLOR]
[COLOR=Royalblue]On[/COLOR] [COLOR=Royalblue]Error[/COLOR] [COLOR=Royalblue]GoTo[/COLOR] [COLOR=crimson]0[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Upvote 0
Thanks Akuini,

Many Many Thanks.... Working Just Perfect :)

Regards,

Humayun
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
 
Upvote 0
Hi Akuini,

Just to update you...

I wanted the criteria row to be auto fit if its less then 35.

i changed the line in the code accordingly.

Code:
If Rows(dS).RowHeight < 35 Then Rows(dS).AutoFit
 
Upvote 0
Hi Akuini,

Thanks once again for the code you provided few months back. I am using it and its working just fine. There is an issue I came across and would like to ask you.

The code was not filtering columns which contains dates (Columns C,N & O) in my case - so I tried to figure out what actually is happening and i came up with this that the cells where i am supposed to enter the criteria is formatted as custom format (mmm-yy) so I changed the format to general and it worked fine I mean it started filtering the dates columns as long as i am entering years in search criteria like 2014, 2019 etc. but as soon as i enter for example Oct-13 then it shows the filter once and the format of the cell again changes to (mmm-yy) and then i am not even able to enter years.

I would really appreciate your help.

Regards,

Humayun
 
Upvote 0
Hi Akuini,

Thanks once again for the code you provided few months back. I am using it and its working just fine. There is an issue I came across and would like to ask you.

The code was not filtering columns which contains dates (Columns C,N & O) in my case

Humayun

I hope I understand you correctly.
Try this:
1. Change this line:
Code:
z = Cells(i, j)
to this:
Code:
z = Cells(i, j).Text

2. Format row 2 as text.

3. You may use whatever date format you want in data (below row 3) in columns C,N & O or any column, but it will be treated as text, it means "what you see is what you get".
So for example, if you use "mmm-dd" then you can't search by year because there is no year shows in the cells.
 
Upvote 0
Hi Akuini,

Thanks for the reply as always

I made the change in the code as you said.
Moreover, I also changed row # 2 to text format where i am entering the search criteria.

If I want to see years then I just type -14 in the criteria and it shows all data of 2014 year
If I want to see dates then I just type 14- in the criteria and it shows all data of 14 days

Now I get what I see :)

Thanks & Regards,

Humayun
 
Upvote 0

Forum statistics

Threads
1,213,521
Messages
6,114,104
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top