VBA: filter multiple data from different sheets based on a dynamic range

Hello experts,

I use the following vba in order to filter column A of every sheet except (Runner2) based on the information report in B1.

Sub Macro1()

    ActiveSheet.Range("$A$1:$E$366").AutoFilter Field:=1
    ActiveSheet.Range("$A$1:$E$366").AutoFilter Field:=1, Criteria1:="=*1111*" _
        , Operator:=xlAnd
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WS As Worksheet
    If Target.Row = 1 And Target.Column = 2 Then
        v = Cells(Target.Row, Target.Column)
        For Each WS In Worksheets
            If LCase(WS.Name) <> "runner" Then
                WS.Range("$A:$E").AutoFilter Field:=1
                WS.Range("$A:$E").AutoFilter Field:=1, Criteria1:="=*" & v & "*", Operator:=xlAnd
            End If
        Next
    End If
End Sub

Open in new window


I would like to add an additional requirement to the vba:

The filter need to take into account not just the information of Range B1 but all the information report in column B ex:

2015-08-20-10-10-00-Microsoft-Excel---Ch

Thank you again for your help.
Check-logs-V2.xlsm
LVL 1
LD16Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LD16Author Commented:
For your info, I use the following vba to filter based on a range:

 Sub auto_filter_based_on_range()

'-----------------------------------------------------------'
'If you want to setup a permanent Activecell in columns J
'lastrowcolJ = Range("J65533").End(xlUp).Row
'Range("J2:J" & lastrowcolJ)
'-------------------------------------------------------------'

 Dim Arr As Variant
 Dim cn As Integer
    Dim i As Integer
    On Error GoTo exit_sub
 cn = ActiveCell.Column
 If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
 
 Arr = Application.InputBox(prompt:="Enter the range to filter", Type:=8)
 
 Arr2 = Application.Transpose(Arr)
 
 For i = LBound(Arr2) To UBound(Arr2)
        Arr2(i) = CStr(Arr2(i))
    Next i
 
ActiveSheet.UsedRange.AutoFilter Field:=cn, Criteria1:=Arr2, Operator:=xlFilterValues
exit_sub:
End Sub

Open in new window

0
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WS As Worksheet
    If (Target.Row = 1 And Target.Column = 2) Or (Target.Row = 2 And Target.Column = 2) Then
        v1 = Cells(1, 2)
        v2 = Cells(2, 2)
        For Each WS In Worksheets
            If LCase(WS.Name) <> "runner2" Then
                WS.Range("$A:$E").AutoFilter Field:=1
                WS.Range("$A:$E").AutoFilter Field:=1, Criteria1:="=*" & v1 & "*", Criteria2:="=*" & v2 & "*", Operator:=xlAnd
            End If
        Next
    End If
End Sub

Open in new window


pls note that AutoFilter method only allowed to take up to 2 criteria.
Check-logs-V2-b.xlsm
0
LD16Author Commented:
Ok, it works, but is not a way to apply another method rather than AutoFilter?

Thank you again for your help.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
>>but is not a way to apply another method rather than AutoFilter?
as far as I know, if we are using AutoFilter, maximum only 2 criteria can be used.

Auto filter
Personally thinking if you want to have more than 2 criteria, then we may need to use dynamic query to get the results you wanted, like using a .dqy file which generated from Microsoft Query that embedded in Excel.
0
LD16Author Commented:
Oki,

But I know that we can filter more than two criterias with an array something like this:

Sub auto_filter_based_on_range()

'-----------------------------------------------------------'
'If you want to setup a permanent Activecell in columns J
'lastrowcolJ = Range("J65533").End(xlUp).Row
'Range("J2:J" & lastrowcolJ)
'-------------------------------------------------------------'

 Dim Arr As Variant
 Dim cn As Integer
    Dim i As Integer
    On Error GoTo exit_sub
 cn = ActiveCell.Column
 If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
 
 Arr = Application.InputBox(prompt:="Enter the range to filter", Type:=8)
 
 [b]Arr2 = Application.Transpose(Arr)[/b]
 
 For i = LBound(Arr2) To UBound(Arr2)
        Arr2(i) = CStr(Arr2(i))
    Next i
 
ActiveSheet.UsedRange.AutoFilter Field:=cn, Criteria1:=Arr2, Operator:=xlFilterValues
exit_sub:
End Sub

Open in new window


Is not a way to take combine this range filter based on the array (instead of having application.inputbox we define the range in that case Range("B2:B" & Lastrow)?

Thank you again for your help.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Though another approach would be looping.

See if the following code helps you.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim ws As Worksheet
Dim lr As Long, i As Long, wlr As Long, r As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row

    If Target.Column = 2 Then
        For Each ws In Worksheets
            If LCase(ws.Name) <> "runner2" Then
                ws.Rows.Hidden = False
                wlr = ws.Cells(Rows.Count, 1).End(xlUp).Row
                For i = 2 To wlr
                    For r = 1 To lr
                        ws.Range("A" & i).EntireRow.Hidden = False
                        If WorksheetFunction.CountIf(ws.Cells(i, 1), "*" & Cells(r, 2)) > 0 Then
                            ws.Range("A" & i).EntireRow.Hidden = False
                            Exit For
                        Else
                            ws.Range("A" & i).EntireRow.Hidden = True
                        End If
                    Next r
                Next i
            End If
        Next
    End If
End Sub

Open in new window

0
LD16Author Commented:
Thank you very much for this proposal.

I tested your code but I don't have the expected result:

When your private sub is called based on the following information:

2015-08-20-13-10-09-Microsoft-Excel---Ch
I got the following result:

2015-08-20-13-10-26-Microsoft-Excel---Ch
And I should have the following result:

2015-08-20-13-11-16-Microsoft-Excel---Ch
Thank you again for your help.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
The code is for Worksheet Change Event and should be place on Runner2 Sheet Module.
And the code will be triggered once you change the values in col. B.

I have placed the code in the sheet module and it is returning the output what you are expecting it to return.

For details see the attached.
Check-logs-V2-1.xlsm
1
LD16Author Commented:
Perfect, it works, however I see that the filter is not applied for the second sheet CCWT_requests.

Thank you again for your help.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
The code doesn't apply filter on the sheets rather the code hides and unhides the rows as per the criteria and it takes place every time you change the values in col. B on Runner 2 Sheet.
0
LD16Author Commented:
Thank you for your comment.
In that case is there a way to hide and unhide the rows of all the sheets <> runner2. The thing is that the code should be applied for the various sheets <>runner and not just for the first sheet CCWT_requests.

Thank you again for your help.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Since you have this condition to check If LCase(ws.Name) <> "runner2" Then, the code will be executed on all the sheets in the workbook except runner2.

Isn't it doing the same thing?

The sample workbook I uploaded with my last reply had three sheets and code successfully executed on rest of two sheets not only on first sheet other than runner2. Didn't it?
0
aikimarkCommented:
You should be using an advancedfilter not a regular filter.
0
aikimarkCommented:
I added a routine (Q_28707160) in the (new) Module3.  It applies an advancedfilter to the non-Runner2 worksheets.

Note: you can hide the criteria column (C) on the Runner2 worksheet.  I protected the column with a password=28707160
Check-logs-V2.xlsm
1
LD16Author Commented:
Perfect I tested and it works, however is there a way to have the data refresh automatically.
With the current version I need to enter  the data in column B and run the macro to hide the values. Is there a way to enter the data in column B and automatically hide the values without launching the macro.

Thank you very much for your help.
0
LD16Author Commented:
I found also something strange.

When I want to filter one value with your code I have the following result:

2015-08-20-19-24-51-Microsoft-Excel---Ch2015-08-20-19-25-03-Microsoft-Excel---Ch
In order to get the expected result I need to enter as following the information

2015-08-20-19-25-28-Microsoft-Excel---Ch2015-08-20-19-25-36-Microsoft-Excel---Ch

Thank you in advance for your help.
0
aikimarkCommented:
Ah.  I didn't test the single item filter condition.  Hang on.
0
aikimarkCommented:
Please try this version.  In my tests, it works with both single and multiple valued lists in column B.
Sub Q_28707160()
    Dim wks As Worksheet
    Dim rngCriteria As Range
    With Worksheets("Runner2")
        Set rngCriteria = .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 1)
        Set rngCriteria = .Range(rngCriteria, rngCriteria.End(xlUp))
    End With
    Application.ScreenUpdating = False
    For Each wks In Worksheets
        If wks.Name = "Runner2" Then
        Else
            wks.UsedRange.AdvancedFilter xlFilterInPlace, rngCriteria
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
@aikimark,

the scripts you posted in comment: ID: 40939780 seems doesn't work well IF the last value entered in Runner2's Column B can not be found in respective worksheets.

it seems that it only checks for the last value.

runner2worksheet
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
@Ryan

I think both of the codes i.e. mine and aikimark's work okay if the criteria value in column B is not found in the target sheets.

Did you try to run the code present on Module3 of the workbook aikimark uploaded?

Though still I am not sure what issue OP is having with my code as it produces the desired output.
0
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
@sktneer

Ok, now tested both yours and aikimark's solutions, both working nicely. There was an extra "IF" statement in my own codes which stop the scripts to be executed. My bad... but thks for highlighting.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
No problem Ryan!
Thanks for confirming that my code also worked as per the OP's requirement. :)
0
aikimarkCommented:
You have an empty cell in your column B values.  The example data you posted only showed contiguous data values.  VBA code can removed empty cells from column B, but I did not include that because it wasn't in your posted examples.

Does the filtering work if you remove the empty cell?
0
LD16Author Commented:
Thank you all for your solutions.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.