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

H

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,539
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
 
Sort by date Sort by votes
Hi Fluff,

I looked into that but that’s not what I want.
The code which Akuini provided in post # 2 allows me to enter as many criterias as I want along with names separated by comma. Only thing I want fro the code is to allow me to enter part of names instead of full name.

I experimented a bit myself with this line of the code..... u can see post # 7.

This allowed me to enter as many names in the cell with comma. But full names
Split(Range("D4"), ",")


I amended it a bit to accept contains part instead of full names.
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 ??
 
Last edited:
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
If you enter the value in D4 like *To*,*Sm* then it will work, but only for TWO values.
 
Upvote 0
Code: 
[COLOR=#333333]If you enter the value in D4 like *To*,*Sm* then it will work, but only for TWO values.[/COLOR]

Exactly that is why I want this part of the code to be modified a bit further - which I am unable to do.

Code: 
[COLOR=#333333]Split("*" & Range("D4") & "*", ",")[/COLOR]
 
Upvote 0
Unless you use an EXACT match, you can only have TWO criteria when using autofilter.
 
Upvote 0
Ok got it...

one last issue as of now
when I press delete in any of the 3 empty cell then it shows filter arrows

here is the code

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
 
Last edited:
Upvote 0
Add this before the With statement & do the same for the other arrays
Code: 
If UBound(arr1) < 1 Then arr1 = "*"
 
Upvote 0
I think I can write a code that meet your requirement i.e searching partial match, multi criteria (as many as you want), without showing filter dropdown. But it won't be using autofiler, just a code to show only the rows that meet the criteria.
Let me now know if your interested.
 
Upvote 0
Code: 
[COLOR=#333333]Add this before the With statement & do the same for the other arrays[/COLOR][COLOR=#333333]Code:
[/COLOR]
[COLOR=#333333]If UBound(arr1) < 1 Then arr1 = "*"[/COLOR]

Code is not filtering records when i added this part.. Or maybe i am not adding it in the right area

Code: 
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"), ",")


   If UBound(arr1) < 1 Then arr1 = "*"
   If UBound(arr2) < 1 Then arr2 = "*"
   If UBound(arr3) < 1 Then arr3 = "*"
    
    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
 
Upvote 0
I think I can write a code that meet your requirement i.e searching partial match, multi criteria (as many as you want), without showing filter dropdown. But it won't be using autofiler, just a code to show only the rows that meet the criteria.
Let me now know if your interested.
Click to expand...


Thanks Akuini,

Sure please if u can provide a code.

Row # 2 is where I will be entering the criterias with comma separated values or text.
Row # 3 contains Headings
Row # 4 is where the data starts all the way down to some 700 rows & will keep on increasing with time.

Data goes from column A:V ( Total 22 Coulms).
Some columns contains text and some contains number and some dates.

Regards,

Humayun
 
Upvote 0
hrayani said:
Thanks Akuini,

Sure please if u can provide a code.
Click to expand...

Ok, try this:
Note:
- Since it's not a real filter then the data is treated as text, so you can't use operator like ">100".
- You can modify the code to suit your data set up in this part:
Private Const SRA As String = "A2:E2" 'address where you type the search criteria
Private Const dS As Long = 2 'row where you type the search criteria
Private Const dc As Long = 1 'First column of data
Private Const dr As Long = 4 'First row of data (exclude header)

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] dc [color=Royalblue]As[/color]  [color=Royalblue]Long[/color] = [color=crimson]1[/color]   [i][color=seagreen]'First column of data[/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]
        [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]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]


[color=Royalblue]Sub[/color] toClearFilter()
rr = Cells.Find([color=brown]"*"[/color], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range([color=brown]"A1:A"[/color] & rr).EntireRow.Hidden = [color=Royalblue]False[/color]
Range(SRA).ClearContents

[color=Royalblue]End[/color] [color=Royalblue]Sub[/color]
[/FONT]

Example:

<b></b><table cellpadding="2.5px" rules="all" style=";background-color: rgb(255,255,255);border: 1px solid;border-collapse: collapse; border-color: rgb(187,187,187)"><colgroup><col width="25px" style="background-color: rgb(218,231,245)" /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: rgb(218,231,245);text-align: center;color: rgb(22,17,32)"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th></tr></thead><tbody><tr ><td style="color: rgb(22,17,32);text-align: center;">1</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">2</td><td style="background-color: #FFE699;;">a,e</td><td style="background-color: #FFE699;;">an,o</td><td style="text-align: right;background-color: #FFE699;;"></td><td style="text-align: right;background-color: #FFE699;;">3</td><td style="text-align: right;background-color: #FFE699;;"></td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">3</td><td style="background-color: #BDD7EE;;">NAME</td><td style="background-color: #BDD7EE;;">CITY</td><td style="background-color: #BDD7EE;;">STATE</td><td style="background-color: #BDD7EE;;">ID</td><td style="background-color: #BDD7EE;;">DATE</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">20</td><td style=";">ee</td><td style=";">Altamonte Springs</td><td style=";">Florida</td><td style="text-align: right;;">234</td><td style="text-align: right;;">02-Feb</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">24</td><td style=";">Truman</td><td style=";">Anaheim</td><td style=";">California</td><td style="text-align: right;;">234</td><td style="text-align: right;;">02-Mei</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">27</td><td style=";">Leonardo</td><td style=";">Ankeny</td><td style=";">Iowa</td><td style="text-align: right;;">933</td><td style="text-align: right;;">01-Apr</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">28</td><td style=";">Marlonat</td><td style=";">Ann Arbor</td><td style=";">Michigan</td><td style="text-align: right;;">234</td><td style="text-align: right;;">03-Mei</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">43</td><td style=";">Leonardo</td><td style=";">Atlanta</td><td style=";">Georgia</td><td style="text-align: right;;">933</td><td style="text-align: right;;">03-Mei</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">45</td><td style=";">a</td><td style=";">Attleboro</td><td style=";">Massachusetts</td><td style="text-align: right;;">345</td><td style="text-align: right;;">02-Feb</td></tr></tbody></table><p style="width:4,8em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid rgb(187,187,187);border-top:none;text-align: center;background-color: rgb(218,231,245);color: rgb(22,17,32)">Sheet1</p><br /><br />

Workbook:

https://www.dropbox.com/s/gvvpo7240...dment-filter-values-seperated-comma.xlsm?dl=0
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Search/Filter a Spreadsheet by User Entered Value
Replies
3
Views
227
jbennett01
J
I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
411
Peter_SSs
Peter_SSs
J
  • Solved
VBA to search or autofilter
Replies
2
Views
375
Jagat Pavasia
J
A
  • Question Question
Counta Of Filtered Data - Errors In VBA Formula (Poor adaptation)
Replies
4
Views
62
Skyybot
Skyybot
A
  • Solved
VBA Autofilter partial match in two column
Replies
4
Views
516
alantse2010
A

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

Share this page

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