VBA Auto Filter

H

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,516
Office Version
  1. 2016
Platform
  1. Windows
Hello Friends,

I am using a VBA code to filter record. Here is the code

Sub aaa()

ActiveSheet.Range("A1:B25").AutoFilter Field:=1, Criteria1:=Range("C1"), _
Operator:=xlOr

ActiveSheet.Range("A1:B25").AutoFilter Field:=2, Criteria1:="*a*", _
Operator:=xlAnd

End Sub
Click to expand...

I would like to give a range (D1) in the Field:=2 part of the code instead of "a"

Any help will be appreciated

Regards,

Humayun
 
Sort by date Sort by votes

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Hi JustynaMK,

There is some change in the sheet where i was using this code. The values in range A4:A1000 contains values instead of formula result.

What i noticed is after this change the code stops working. Like it takes too long reading & when i break the code to enter it the "End If" line is highlited.

Here is the code

Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim lngRow              As Long
    Dim blnA                As Boolean
    Dim blnB                As Boolean
    Dim blnC                As Boolean
    Dim blnD                As Boolean
    Dim blnE                As Boolean
    Dim blnF                As Boolean
    Dim blnG                As Boolean
    Dim blnH                As Boolean
    Dim blnI                As Boolean
    Dim blnJ                As Boolean
    Dim blnK                As Boolean
    Dim blnL                As Boolean
    Dim blnM                As Boolean
    Dim blnN                As Boolean
    Dim blnO                As Boolean
    Dim blnP                As Boolean
    Dim blnQ                As Boolean
    Dim blnR                As Boolean
    Dim blnS                As Boolean
    Dim blnT                As Boolean
    Dim blnU                As Boolean
    Dim blnV                As Boolean
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        
        For lngRow = 4 To 1000
            If lngRow <= 1000 Then
                blnA = InStr(UCase(.Range("A" & lngRow).Value), UCase(.Range("A2").Value)) Or (Len(.Range("A2").Value) = 0)
                blnB = InStr(UCase(.Range("B" & lngRow).Value), UCase(.Range("B2").Value)) Or (Len(.Range("B2").Value) = 0)
                blnC = InStr(UCase(.Range("C" & lngRow).Value), UCase(.Range("C2").Value)) Or (Len(.Range("C2").Value) = 0)
                blnD = InStr(UCase(.Range("D" & lngRow).Value), UCase(.Range("D2").Value)) Or (Len(.Range("D2").Value) = 0)
                blnE = InStr(UCase(.Range("E" & lngRow).Value), UCase(.Range("E2").Value)) Or (Len(.Range("E2").Value) = 0)
                blnF = InStr(UCase(.Range("F" & lngRow).Value), UCase(.Range("F2").Value)) Or (Len(.Range("F2").Value) = 0)
                blnG = InStr(UCase(.Range("G" & lngRow).Value), UCase(.Range("G2").Value)) Or (Len(.Range("G2").Value) = 0)
                blnH = InStr(UCase(.Range("H" & lngRow).Value), UCase(.Range("H2").Value)) Or (Len(.Range("H2").Value) = 0)
                blnI = InStr(UCase(.Range("I" & lngRow).Value), UCase(.Range("I2").Value)) Or (Len(.Range("I2").Value) = 0)
                blnJ = InStr(UCase(.Range("J" & lngRow).Value), UCase(.Range("J2").Value)) Or (Len(.Range("J2").Value) = 0)
                blnK = InStr(UCase(.Range("K" & lngRow).Value), UCase(.Range("K2").Value)) Or (Len(.Range("K2").Value) = 0)
                blnL = InStr(UCase(.Range("L" & lngRow).Value), UCase(.Range("L2").Value)) Or (Len(.Range("L2").Value) = 0)
                blnM = InStr(UCase(.Range("M" & lngRow).Value), UCase(.Range("M2").Value)) Or (Len(.Range("M2").Value) = 0)
                blnN = InStr(UCase(.Range("N" & lngRow).Value), UCase(.Range("N2").Value)) Or (Len(.Range("N2").Value) = 0)
                blnO = InStr(UCase(.Range("O" & lngRow).Value), UCase(.Range("O2").Value)) Or (Len(.Range("O2").Value) = 0)
                blnP = InStr(UCase(.Range("P" & lngRow).Value), UCase(.Range("P2").Value)) Or (Len(.Range("P2").Value) = 0)
                blnQ = InStr(UCase(.Range("Q" & lngRow).Value), UCase(.Range("Q2").Value)) Or (Len(.Range("Q2").Value) = 0)
                blnR = InStr(UCase(.Range("R" & lngRow).Value), UCase(.Range("R2").Value)) Or (Len(.Range("R2").Value) = 0)
                blnS = InStr(UCase(.Range("S" & lngRow).Value), UCase(.Range("S2").Value)) Or (Len(.Range("S2").Value) = 0)
                blnT = InStr(UCase(.Range("T" & lngRow).Value), UCase(.Range("T2").Value)) Or (Len(.Range("T2").Value) = 0)
                blnU = InStr(UCase(.Range("U" & lngRow).Value), UCase(.Range("U2").Value)) Or (Len(.Range("U2").Value) = 0)
                blnV = InStr(UCase(.Range("V" & lngRow).Value), UCase(.Range("V2").Value)) Or (Len(.Range("V2").Value) = 0)
                .Rows(lngRow).Hidden = ((blnA + blnB + blnC + blnD + blnE + blnF + blnG + blnH + blnI + blnJ + blnK + blnL + blnM + blnN + blnO + blnP + blnQ + blnR + blnS + blnT + blnU + blnV) > -22)
            
            End If
        Next lngRow
        
    End With
   
End Sub

Any Idea ???
 
Upvote 0
Hello,

i figured out what’s happening. Though I don’t have solution for it :(

the code stops working or takes long long time to work when I created some named ranges in this sheet and tried to extract data with the help of a formula from this sheet to the other.

otherwise the code is working perfect.

Any idea .......???
 
Upvote 0
Hi hrayani,

Not quite sure why this is happening - might be caused by Excel file trying to re-calculate all formulas every time a row is getting hidden.

I tried to simplify the code as much as possible plus disable calculations for the duration of this macro. If it doesn't work, then sorry - I'm out of ideas!

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngRow              As Long
    Dim lngColumn           As Long
    Dim lngCount            As Long
    Dim blnCheck            As Boolean
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With ActiveSheet
        For lngRow = 4 To 1000
            If lngRow <= 1000 Then
                For lngColumn = 1 To 22
                    blnCheck = InStr(UCase(.Cells(lngRow, lngColumn).Value), UCase(.Cells(2, lngColumn).Value)) Or (Len(.Cells(2, lngColumn).Value) = 0)
                    lngCount = lngCount + blnCheck
                Next lngColumn
                .Rows(lngRow).Hidden = (lngCount > -22)
                lngCount = 0
            End If
        Next lngRow
    End With
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
Hi Justyna,

First of all thanks very much....

you r right in saying

might be caused by Excel file trying to re-calculate all formulas every time a row is getting hidden.
Click to expand...

I tried the new code which is working perfect but what i did is i added the line calculation manual and auto in the previous code and compared the speed of both the codes and found the speed more or less same...

well both r working just perfect now...

Thanks Once again

Humayun
 
Upvote 0
Hi Justy,

I need a bit of more from this code...

Here is the code you provided.


Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim lngRow              As Long
    Dim blnA                As Boolean
    Dim blnB                As Boolean
    Dim blnC                As Boolean
    Dim blnD                As Boolean
    Dim blnE                As Boolean
    Dim blnF                As Boolean
    Dim blnG                As Boolean
    Dim blnH                As Boolean
    Dim blnI                As Boolean
    Dim blnJ                As Boolean
    Dim blnK                As Boolean
    Dim blnL                As Boolean
    Dim blnM                As Boolean
    Dim blnN                As Boolean
    Dim blnO                As Boolean
    Dim blnP                As Boolean
    Dim blnQ                As Boolean
    Dim blnR                As Boolean
    Dim blnS                As Boolean
    Dim blnT                As Boolean
    Dim blnU                As Boolean
    Dim blnV                As Boolean
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With ActiveSheet
        
        For lngRow = 4 To 1002
            If lngRow <= 1002 Then
                blnA = InStr(UCase(.Range("A" & lngRow).Value), UCase(.Range("A2").Value)) Or (Len(.Range("A2").Value) = 0)
                blnB = InStr(UCase(.Range("B" & lngRow).Value), UCase(.Range("B2").Value)) Or (Len(.Range("B2").Value) = 0)
                blnC = InStr(UCase(.Range("C" & lngRow).Value), UCase(.Range("C2").Value)) Or (Len(.Range("C2").Value) = 0)
                blnD = InStr(UCase(.Range("D" & lngRow).Value), UCase(.Range("D2").Value)) Or (Len(.Range("D2").Value) = 0)
                blnE = InStr(UCase(.Range("E" & lngRow).Value), UCase(.Range("E2").Value)) Or (Len(.Range("E2").Value) = 0)
                blnF = InStr(UCase(.Range("F" & lngRow).Value), UCase(.Range("F2").Value)) Or (Len(.Range("F2").Value) = 0)
                blnG = InStr(UCase(.Range("G" & lngRow).Value), UCase(.Range("G2").Value)) Or (Len(.Range("G2").Value) = 0)
                blnH = InStr(UCase(.Range("H" & lngRow).Value), UCase(.Range("H2").Value)) Or (Len(.Range("H2").Value) = 0)
                blnI = InStr(UCase(.Range("I" & lngRow).Value), UCase(.Range("I2").Value)) Or (Len(.Range("I2").Value) = 0)
                blnJ = InStr(UCase(.Range("J" & lngRow).Value), UCase(.Range("J2").Value)) Or (Len(.Range("J2").Value) = 0)
                blnK = InStr(UCase(.Range("K" & lngRow).Value), UCase(.Range("K2").Value)) Or (Len(.Range("K2").Value) = 0)
                blnL = InStr(UCase(.Range("L" & lngRow).Value), UCase(.Range("L2").Value)) Or (Len(.Range("L2").Value) = 0)
                blnM = InStr(UCase(.Range("M" & lngRow).Value), UCase(.Range("M2").Value)) Or (Len(.Range("M2").Value) = 0)
                blnN = InStr(UCase(.Range("N" & lngRow).Value), UCase(.Range("N2").Value)) Or (Len(.Range("N2").Value) = 0)
                blnO = InStr(UCase(.Range("O" & lngRow).Value), UCase(.Range("O2").Value)) Or (Len(.Range("O2").Value) = 0)
                blnP = InStr(UCase(.Range("P" & lngRow).Value), UCase(.Range("P2").Value)) Or (Len(.Range("P2").Value) = 0)
                blnQ = InStr(UCase(.Range("Q" & lngRow).Value), UCase(.Range("Q2").Value)) Or (Len(.Range("Q2").Value) = 0)
                blnR = InStr(UCase(.Range("R" & lngRow).Value), UCase(.Range("R2").Value)) Or (Len(.Range("R2").Value) = 0)
                blnS = InStr(UCase(.Range("S" & lngRow).Value), UCase(.Range("S2").Value)) Or (Len(.Range("S2").Value) = 0)
                blnT = InStr(UCase(.Range("T" & lngRow).Value), UCase(.Range("T2").Value)) Or (Len(.Range("T2").Value) = 0)
                blnU = InStr(UCase(.Range("U" & lngRow).Value), UCase(.Range("U2").Value)) Or (Len(.Range("U2").Value) = 0)
                blnV = InStr(UCase(.Range("V" & lngRow).Value), UCase(.Range("V2").Value)) Or (Len(.Range("V2").Value) = 0)
                .Rows(lngRow).Hidden = ((blnA + blnB + blnC + blnD + blnE + blnF + blnG + blnH + blnI + blnJ + blnK + blnL + blnM + blnN + blnO + blnP + blnQ + blnR + blnS + blnT + blnU + blnV) > -22)
            
            End If
        Next lngRow
        
    End With
      Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
   
End Sub

currently the code is filtering records whatever criteria is added in row 2.
I want the code to filter record whatever is added in row 1 & 2.
Is it possible ??

Regards,

Humayun
 
Upvote 0
Hi,

Actually this is what i require.. The data should filter records for Multiple Criteria entered in row # 2.

Heading in Row # 3
Data Range > A4:V1000

An amendment in the code mentioned in POST # 37 or even a new filter code would do.

Regards,

Humayun
 
Last edited:
Upvote 0
Hi Humayun,

In our original code, you will notice that we are using the following code:

Code: 
blnA = InStr(UCase(.Range("A" & lngRow).Value), UCase(.Range("A2").Value)) Or (Len(.Range("A2").Value) = 0)

For each such line, you need to change "A2" to "A3", "B2" to "B3" etc. in order to use the 3rd row as your filter.
 
Upvote 0
Hi Justy,

Thanks for the reply. Yes you r right in saying that I should change A2 to A3 to change the criteria row from 2 to 3 but that’s not what I am looking for. I don’t want to change the criteria row dear.

As of now what the code is doing is - it is looking at whatever criteria is added in row # 2 and it’s perfectly filtering records.

For Example
Column D contains names like John, Smith, Tony, Peter etc.
Now if I enter Peter in row # 2 then it is filtering all records for Peter which is absolutely perfect.

Now what I want from the code is to filter records even if multiple criterias are added in the same row # 2.

For Example
Column D contains names like John, Smith, Tony, Peter etc.
Now if I enter Peter, Tony (2 or more criterias with a comma or any other separator which the code allows) then it should filter all records for Peter & Tony.

Only difference is that as of now the code is accepting single criteria & I want it to accept & filter multiple criterias.

Secondly, row # 2 contains data validation where the criteria is entered. Is it possible to have a drop down list from which we can select all the criterias like what we do when we apply normal filter. We select all the criterias from the list. Like we have a checkbox in the filter list.

Best Regards,

Humayun
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
102
Peter_SSs
Peter_SSs
J
  • Solved
Search/Filter a Spreadsheet by User Entered Value
Replies
3
Views
90
jbennett01
J
S
  • Solved
How to filter and change text in Macro
Replies
2
Views
234
SCPbrito
S
S
  • Solved
Return error if "Filter" doesn't return the required entry
Replies
2
Views
118
skittlz
S
V
  • Question Question
autofilter
Replies
2
Views
269
vmjan02
V

Forum statistics

Threads
1,223,244
Messages
6,170,976
Members
452,372
Latest member
Natalie18

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