Link to home
Start Free TrialLog in
Avatar of ctownsen80
ctownsen80Flag for Afghanistan

asked on

Filtering Code

I need code that will do the following.
1.filter each tab based on the selected filter in B1:B5
2.filter each pivot table and its corresponding pivot graph based on the selected criteria
3.if the selection does not apply to the filter the pivot chart should update to 0 or empty on the summary tab
For example if Test1 in Level6, chart P1 on the summary tab should be reduce to nothing. Please see the example

Any Takers?


edit by modus_operandi:
Please refer to replacement file in http:#a35257087
ASKER CERTIFIED SOLUTION
Avatar of dlmille
dlmille
Flag of United States of America image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of ctownsen80
ctownsen80
Flag of Afghanistan image

ASKER

Step 3 is not working. If the sumif is the more efficient route, please move forward.
Avatar of dlmille
dlmille
Flag of United States of America image
Ok - this was fun, lol.  I spent a while putting in COUNTIFS and SUMIFS then started thinking about the data, the convenience of Pivot Tables, and the fact that keys could change, etc., which we'd need to handle in the SUMIFS/COUNTIFS case and while it WOULD WORK, I took a look again at the problem with #3 while I was running a macro on the initial approach....

I found this could be simplified quite a bit (the code) while maintaining credibility and supportability (as you designed it).  Here's the situation:

1.  If there is a LEVEL that doesn't match in a PivotTable, then we should get the NULL set.  One way to get the NULL set is to set EVERY Level to "(blank)" - how about that?
2.  So, we'd need to set all the Levels to "(blank)" on the no-match condition.
3.  However, we'd need to reset all the Levels once a new change is made.

So the process is this:

1.  First - need to check to see if levels are changing at all on the Summary sheet, otherwise exit the sub - this is handled with this code:

  
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("B1:B5")) Is Nothing Then 'check to see if levels are changing, otherwise, do nothing
        Exit Sub 'exits if levels not changing
    End If

Open in new window


2.  Then - at the start - let's set all Levels (and nothing else) to "(All)" at the start - note the new variable array strFields() as string.  Also, the levelSelection range variable that we'll be matching against:
  
strFields(1) = strField1
strFields(2) = strField2
strFields(3) = strField3
strFields(4) = strField4
strFields(5) = strField5

Set levelSelection = ThisWorkbook.Sheets("Summary").Range("B1")

On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False

    'first - initialize EVERYTHING to (ALL), second, make changes, Level by Level and if notFound, reset everything to (blank)
    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            For Each pf In pt.PageFields
                If InStr(pf.Name, "Level") <> 0 Then 'reset the levels
                    pf.CurrentPage = "(ALL)"
                End If
            Next pf
        Next pt
    Next ws

Open in new window


3.  Finally - we set the levels - for every level - and count the number of times we're successful.  AND if we're NOT, then we do the same routine as the first, except we set ALL levels to "(blank)":

  
'NOW - set the Levels, and if ANY of the levels have no match, set ALL levels to (blank)!
        
    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            foundCount = 0
            For i = 1 To UBound(strFields) '1 to the number of levels we care about
                With pt.PageFields(strFields(i))
                    If levelSelection.Offset(i - 1, 0).Value = "All" Then ' then just set it
                        .CurrentPage = "(ALL)"
                        foundCount = foundCount + 1
                    Else
                        For Each pi In .PivotItems
                            If pi.Value = levelSelection.Offset(i - 1, 0).Value Then 'check each level indicator's value
                                .CurrentPage = pi.Value 'so set it on the match
                                If Err.Number = 0 Then
                                    foundCount = foundCount + 1 'increment the found count
                                Else
                                    Err.Clear 'clear for the next check
                                End If
                            End If
                        Next pi
                    End If
                End With
            Next i
            If foundCount < UBound(strFields) Then ' so set them all to blank
                For i = 1 To UBound(strFields)
                    With pt.PageFields(strFields(i))
                        .CurrentPage = "(blank)"
                    End With
                Next i
            End If
        Next pt
    Next ws

Open in new window


Then we reenable events and move forward with the rest of the code....

It seems to test well, for me.  Let me know what you think!

PS - I don't believe you need to turn events off, as you are making no changes in the Summary sheet, so I commented that out.

Here's the entire codepage (I recommend moving almost all of it to an independent MODULE) - and I've done that in the attached:
  
Option Base 1 ' to align array with strField names

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("B1:B5")) Is Nothing Then 'check to see if levels are changing, otherwise, do nothing
        Exit Sub 'exits if levels not changing
    End If
    
Dim ws As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim pf As Variant
Dim strField1 As String
Dim strField2 As String
Dim strField3 As String
Dim strField4 As String
Dim strField5 As String

Dim strFields(5) As String 'hold all the levels we care about
Dim levelSelection As Range
Dim foundCount As Integer 'number of levels that had a match

Dim L2Filter As String
Dim L3Filter As String
Dim L4Filter As String
Dim L5Filter As String
Dim L6Filter As String

strField1 = "Level2"
strField2 = "Level3"
strField3 = "Level4"
strField4 = "Level5"
strField5 = "Level6"

strFields(1) = strField1
strFields(2) = strField2
strFields(3) = strField3
strFields(4) = strField4
strFields(5) = strField5

Set levelSelection = ThisWorkbook.Sheets("Summary").Range("B1")

On Error Resume Next
'Application.EnableEvents = False
Application.ScreenUpdating = False

    'first - initialize EVERYTHING to (ALL), second, make changes, Level by Level and if notFound, reset everything to (blank)
    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            For Each pf In pt.PageFields
                If InStr(pf.Name, "Level") <> 0 Then 'reset the levels
                    pf.CurrentPage = "(ALL)"
                End If
            Next pf
        Next pt
    Next ws
        
    'NOW - set the Levels, and if ANY of the levels have no match, set ALL levels to (blank)!
        
    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            foundCount = 0
            For i = 1 To UBound(strFields) '1 to the number of levels we care about
                With pt.PageFields(strFields(i))
                    If levelSelection.Offset(i - 1, 0).Value = "All" Then ' then just set it
                        .CurrentPage = "(ALL)"
                        foundCount = foundCount + 1
                    Else
                        For Each pi In .PivotItems
                            If pi.Value = levelSelection.Offset(i - 1, 0).Value Then 'check each level indicator's value
                                .CurrentPage = pi.Value 'so set it on the match
                                If Err.Number = 0 Then
                                    foundCount = foundCount + 1 'increment the found count
                                Else
                                    Err.Clear 'clear for the next check
                                End If
                            End If
                        Next pi
                    End If
                End With
            Next i
            If foundCount < UBound(strFields) Then ' so set them all to blank
                For i = 1 To UBound(strFields)
                    With pt.PageFields(strFields(i))
                        .CurrentPage = "(blank)"
                    End With
                Next i
            End If
        Next pt
    Next ws
    
'Application.EnableEvents = True
Application.ScreenUpdating = True



L2Filter = Sheet1.Range("b1").Value
L3Filter = Sheet1.Range("b2").Value
L4Filter = Sheet1.Range("b3").Value
L5Filter = Sheet1.Range("b4").Value
L6Filter = Sheet1.Range("b5").Value

If L2Filter = "All" Then
    Sheet2.Range("a1").AutoFilter Field:=2
    Sheet3.Range("a1").AutoFilter Field:=2
    Sheet4.Range("a1").AutoFilter Field:=2
    Sheet5.Range("a1").AutoFilter Field:=2
    Sheet6.Range("a1").AutoFilter Field:=2
    Sheet10.Range("a1").AutoFilter Field:=1
    Sheet11.Range("a1").AutoFilter Field:=2
Else
    Sheet2.Range("a1").AutoFilter Field:=2, Criteria1:=L2Filter
    Sheet3.Range("a1").AutoFilter Field:=2, Criteria1:=L2Filter
    Sheet4.Range("a1").AutoFilter Field:=2, Criteria1:=L2Filter
    Sheet5.Range("a1").AutoFilter Field:=2, Criteria1:=L2Filter
    Sheet6.Range("a1").AutoFilter Field:=2, Criteria1:=L2Filter
    Sheet10.Range("a1").AutoFilter Field:=1, Criteria1:=L2Filter
    Sheet11.Range("a1").AutoFilter Field:=2, Criteria1:=L2Filter
End If
    
If L3Filter = "All" Then
    Sheet2.Range("a1").AutoFilter Field:=3
    Sheet3.Range("a1").AutoFilter Field:=3
    Sheet4.Range("a1").AutoFilter Field:=3
    Sheet5.Range("a1").AutoFilter Field:=3
    Sheet6.Range("a1").AutoFilter Field:=3
    Sheet10.Range("a1").AutoFilter Field:=2
    Sheet11.Range("a1").AutoFilter Field:=3
Else
    Sheet2.Range("a1").AutoFilter Field:=3, Criteria1:=L3Filter
    Sheet3.Range("a1").AutoFilter Field:=3, Criteria1:=L3Filter
    Sheet4.Range("a1").AutoFilter Field:=3, Criteria1:=L3Filter
    Sheet5.Range("a1").AutoFilter Field:=3, Criteria1:=L3Filter
    Sheet6.Range("a1").AutoFilter Field:=3, Criteria1:=L3Filter
    Sheet10.Range("a1").AutoFilter Field:=2, Criteria1:=L3Filter
    Sheet11.Range("a1").AutoFilter Field:=3, Criteria1:=L3Filter
End If

If L4Filter = "All" Then
    Sheet2.Range("a1").AutoFilter Field:=4
    Sheet3.Range("a1").AutoFilter Field:=4
    Sheet4.Range("a1").AutoFilter Field:=4
    Sheet5.Range("a1").AutoFilter Field:=4
    Sheet6.Range("a1").AutoFilter Field:=4
    Sheet10.Range("a1").AutoFilter Field:=3
    Sheet11.Range("a1").AutoFilter Field:=4
Else
    Sheet2.Range("a1").AutoFilter Field:=4, Criteria1:=L4Filter
    Sheet3.Range("a1").AutoFilter Field:=4, Criteria1:=L4Filter
    Sheet4.Range("a1").AutoFilter Field:=4, Criteria1:=L4Filter
    Sheet5.Range("a1").AutoFilter Field:=4, Criteria1:=L4Filter
    Sheet6.Range("a1").AutoFilter Field:=4, Criteria1:=L4Filter
    Sheet10.Range("a1").AutoFilter Field:=3, Criteria1:=L4Filter
    Sheet11.Range("a1").AutoFilter Field:=4, Criteria1:=L4Filter
End If

If L5Filter = "All" Then
    Sheet2.Range("a1").AutoFilter Field:=5
    Sheet3.Range("a1").AutoFilter Field:=5
    Sheet4.Range("a1").AutoFilter Field:=5
    Sheet5.Range("a1").AutoFilter Field:=5
    Sheet6.Range("a1").AutoFilter Field:=5
    Sheet10.Range("a1").AutoFilter Field:=4
    Sheet11.Range("a1").AutoFilter Field:=5
Else
    Sheet2.Range("a1").AutoFilter Field:=5, Criteria1:=L5Filter
    Sheet3.Range("a1").AutoFilter Field:=5, Criteria1:=L5Filter
    Sheet4.Range("a1").AutoFilter Field:=5, Criteria1:=L5Filter
    Sheet5.Range("a1").AutoFilter Field:=5, Criteria1:=L5Filter
    Sheet6.Range("a1").AutoFilter Field:=5, Criteria1:=L5Filter
    Sheet10.Range("a1").AutoFilter Field:=4, Criteria1:=L5Filter
    Sheet11.Range("a1").AutoFilter Field:=5, Criteria1:=L5Filter
End If

If L6Filter = "All" Then
    Sheet2.Range("a1").AutoFilter Field:=6
    Sheet3.Range("a1").AutoFilter Field:=6
    Sheet4.Range("a1").AutoFilter Field:=6
    Sheet5.Range("a1").AutoFilter Field:=6
    Sheet6.Range("a1").AutoFilter Field:=6
    Sheet10.Range("a1").AutoFilter Field:=5
    Sheet11.Range("a1").AutoFilter Field:=6
Else
    Sheet2.Range("a1").AutoFilter Field:=6, Criteria1:=L6Filter
    Sheet3.Range("a1").AutoFilter Field:=6, Criteria1:=L6Filter
    Sheet4.Range("a1").AutoFilter Field:=6, Criteria1:=L6Filter
    Sheet5.Range("a1").AutoFilter Field:=6, Criteria1:=L6Filter
    Sheet6.Range("a1").AutoFilter Field:=6, Criteria1:=L6Filter
    Sheet10.Range("a1").AutoFilter Field:=5, Criteria1:=L6Filter
    Sheet11.Range("a1").AutoFilter Field:=6, Criteria1:=L6Filter
End If

End Sub

Open in new window


Enjoy!

Dave


edit by modus_operandi:
Please refer to replacement file in http:#a35257087
Avatar of dlmille
dlmille
Flag of United States of America image
Did you accept this BEFORE I posted my solution??

Sorry - I should have given you a progress indicator, I guess, lol...

What's up?

Dave
Avatar of ctownsen80
ctownsen80
Flag of Afghanistan image

ASKER

I am using your solution...thanks for your help.
Avatar of ctownsen80
ctownsen80
Flag of Afghanistan image

ASKER

Any chance that we can delete the Test files? I omitted to exclude all the data that should have been excluded for this test file.
Avatar of dlmille
dlmille
Flag of United States of America image
I'm not sure I understand.  Would you kindly elaborate?

Dave
Avatar of dlmille
dlmille
Flag of United States of America image
Oh - I think I know what you mean.  If you can take the final solution and redact any data and submit, I'll get a moderator to delete the files and replace my posted file with your redacted file (I believe I can make that happen).

Dave
Avatar of ctownsen80
ctownsen80
Flag of Afghanistan image

ASKER

Please see the updated test file and update.

Thanks Again!
Test2-r2b.xlsm