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

 

[hrayani]

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

 

[Akuini]

Try this:

[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]

 

[hrayani]

Thanks Akuini,

Many Many Thanks.... Working Just Perfect

Regards,

Humayun

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.

 

[hrayani]

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.

If Rows(dS).RowHeight < 35 Then Rows(dS).AutoFit

 

[Akuini]

Ok, that would work.

 

[hrayani]

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

 

[Akuini]

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:

z = Cells(i, j)

to this:

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.

 

[hrayani]

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

 

[Akuini]

You're welcome, glad it works.