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

hrayani

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

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Akuini

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

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
910
Office Version
2016
Platform
Windows
Thanks Akuini,

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

Regards,

Humayun
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
You're welcome, glad to help, & thanks for the feedback.:)
 

hrayani

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

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
Ok, that would work.
 

hrayani

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

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

hrayani

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

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
You're welcome, glad it works.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,662
Messages
5,488,166
Members
407,628
Latest member
Faceless Judge

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