Multiple Filters of Pivot Table

[jazz2409]

I have a pivot table with 2 filters: Main LOB and Sub LOB. Whenever I am choosing a Main LOB from its filter, all the available Sub LOBs are also showing instead of just the Sub LOBs of the selected Main LOB. How do I show just the Sub LOBs of the selected Main LOB?
Here's what I have so far: (credits to p45cal (http://www.vbaexpress.com/forum/member.php?3494-p45cal))



With PT
If pf1.CurrentPage.Name = CurrentCat Then
For Each pit In pf2.PivotItems
With Destn1
.Value = pit.Name & " Agents "
With .Font
.Name = "Calibri"
.Size = 11
.Underline = xlUnderlineStyleSingle
.Bold = True
End With
End With
Set Destn1 = Destn1.Offset(2)
pf2.ClearAllFilters 'added this line (makes it a bit more robust).
pf2.CurrentPage = pit.Name
With .TableRange1
.Copy
Destn1.PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
Set myTable = NewSht.ListObjects.Add(xlSrcRange, Destn1.Resize(.Rows.Count, .Columns.Count), , xlYes)
myTable.TableStyle = "TableStyleMedium14"
myTable.ShowTableStyleRowStripes = False
Set Destn1 = Destn1.Offset(.Rows.Count + 2)
End With '.TableRange1
myTable.Unlist
Next pit
End If
'End If End With 'PT

I also posted here: https://superuser.com/questions/1520902/multiple-filters-of-pivot-table?noredirect=1#comment2303582_1520902

[Paul_Hossler]

Slicers would be the easiest way

The attached doesn't use page fields, but slicers also work with them

[jazz2409]

I need to loop through a list of main LOBs and Sub LOBs ..

[Paul_Hossler]

edit - added pivot table




Option Explicit


Sub Demo()
Dim r As Range
Dim C As Collection
Dim i As Long
Dim v As Variant
Dim pt As PivotTable

Set r = ActiveSheet.Cells(1, 1).CurrentRegion

Set C = New Collection


For i = 2 To r.Rows.Count
On Error Resume Next
C.Add r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value, r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value
On Error GoTo 0
Next i


Set pt = ActiveSheet.PivotTables(1)


Application.ScreenUpdating = False
For i = 1 To C.Count
v = Split(C.Item(i), Chr(1))
pt.PivotFields("FIELD1").ClearAllFilters
pt.PivotFields("FIELD1").CurrentPage = v(0)
pt.PivotFields("FIELD2").ClearAllFilters
pt.PivotFields("FIELD2").CurrentPage = v(1)


MsgBox v(0) & " -- " & v(1)
Next i
Application.ScreenUpdating = True


End Sub

[jazz2409]

edit - added pivot table




Option Explicit


Sub Demo()
Dim r As Range
Dim C As Collection
Dim i As Long
Dim v As Variant
Dim pt As PivotTable

Set r = ActiveSheet.Cells(1, 1).CurrentRegion

Set C = New Collection


For i = 2 To r.Rows.Count
On Error Resume Next
C.Add r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value, r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value
On Error GoTo 0
Next i


Set pt = ActiveSheet.PivotTables(1)


Application.ScreenUpdating = False
For i = 1 To C.Count
v = Split(C.Item(i), Chr(1))
pt.PivotFields("FIELD1").ClearAllFilters
pt.PivotFields("FIELD1").CurrentPage = v(0)
pt.PivotFields("FIELD2").ClearAllFilters
pt.PivotFields("FIELD2").CurrentPage = v(1)


MsgBox v(0) & " -- " & v(1)
Next i
Application.ScreenUpdating = True


End Sub




Hmmm sorry but I find it very complicated. May I ask you to kindly help me understand the code?

[Paul_Hossler]

IF i understand the question ...

I created a little 'database' with FIELD1 being the Major and FIELD2 being the minor field

25888


The Collection builds a membership of the combinations of FIELD1 and FIELD2, separated by an ASCII 1 character
Since you can't have a duplicate key in a collection, this is a pretty common way to get a unique list




For i = 2 To r.Rows.Count
On Error Resume Next
C.Add r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value, r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value
On Error GoTo 0
Next i



There's a simple pivot table with FIELD1 and FIELD2 as page fields

25889


This goes through the collection of FIELD1+ASCII 1+FIELD2 values, SPLITs at the ASCII 1

Then sets the FIELD1 page = the first part (major value) and sets FIELD2 page = the second part (minor value)



For i = 1 To C.Count
v = Split(C.Item(i), Chr(1))
pt.PivotFields("FIELD1").ClearAllFilters
pt.PivotFields("FIELD1").CurrentPage = v(0)
pt.PivotFields("FIELD2").ClearAllFilters
pt.PivotFields("FIELD2").CurrentPage = v(1)


MsgBox v(0) & " -- " & v(1)
Next i




25890 25891


I just used MsgBox, but you'd probably want to put your processing there and use pt.TableRange1 to get the data


Here's a more specific version without the ScreenUpdating and using a processing sub (attached)



Option Explicit


Sub Demo()
Dim r As Range
Dim C As Collection
Dim i As Long
Dim v As Variant
Dim pt As PivotTable

Set r = ActiveSheet.Cells(1, 1).CurrentRegion

Set C = New Collection


For i = 2 To r.Rows.Count
On Error Resume Next
C.Add r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value, r.Cells(i, 1).Value & Chr(1) & r.Cells(i, 2).Value
On Error GoTo 0
Next i


Set pt = ActiveSheet.PivotTables(1)


For i = 1 To C.Count
v = Split(C.Item(i), Chr(1))
pt.PivotFields("FIELD1").ClearAllFilters
pt.PivotFields("FIELD1").CurrentPage = v(0)
pt.PivotFields("FIELD2").ClearAllFilters
pt.PivotFields("FIELD2").CurrentPage = v(1)


Call MyProcessing(pt)
Next i
End Sub

Sub MyProcessing(myPT As PivotTable)
Dim r As Range

With myPT
Set r = .TableRange1

Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)

MsgBox "Processing " & .PivotFields("FIELD1").CurrentPage & " -- " & .PivotFields("FIELD2").CurrentPage & _
vbCrLf & vbCrLf & " Data = " & r.Address

End With
End Sub

[jazz2409]

I mean is there a way to remove irrelevant items in the sub LOB filter? Like in your example, if I choose A under FIELD 1 filter, FIELD 2 filter will only show Z, Q, and X, then if I choose B under FIELD 1 filter, filter 2 will only show B and X only?

[Paul_Hossler]

Not that I know

Based on a quick read of your other thread, I didn't think you actually used a PT, except to pull data, and then process that data into some report-able tables

[jazz2409]

Not that I know

Based on a quick read of your other thread, I didn't think you actually used a PT, except to pull data, and then process that data into some report-able tables

Hmm the last item p45cal and I were talking about is creating a pivot table then turning it into a table..

The above code (the one I first posted) works however it also includes the Sub LOB of other Main LOBs -_-

I am open to using slicers since I noticed that slicers kind of does what I need, however I am not sure how to change the above code into using a slicer. I

[jazz2409]

Hmm is it possible to loop through the current Main LOB column in a sheet, get its first Sub LOB then choose that Sub LOB from the items in the filter then create a pivot out of it then convert it into a table, then go back to getting the next Sub LOB of the current Main LOB then do the whole process again? Instead of looping through the items in the filter?

[Paul_Hossler]

Hmm is it possible to loop through the current Main LOB column in a sheet, get its first Sub LOB then choose that Sub LOB from the items in the filter then create a pivot out of it then convert it into a table, then go back to getting the next Sub LOB of the current Main LOB then do the whole process again? Instead of looping through the items in the filter?

Not sure that you mean by "looping through all items in the filter"

Look at ver2 below. It doesn't have the bells and whistles and the formatting.

It just uses a PT to extract the data all combinations of LOB and Sub LOB, one after the other

It then passes that 'filtered' combination of LOB and Sub LOB data to a processing sub

That sub would take the block of data, add missing hours, calculate stuff, format, etc.

Step through the macro and see if it works for you

[jazz2409]

Yeah I think this works the way I need it to.. I'm just confused as to how this very short code was able to produce such output :D

In fact I am so confused I don't actually understand how to apply this to what I am doing :D

[jazz2409]

Hang on.. It also prints out the tables of the other Main LOB

[jazz2409]

Here's the most recent workbook. If you will notice, on each sheet that was created, for example Category 1. In Category 1 Sheet you will see tables for Category 2. I need each sheet to show just its respective Sub LOBs

[Paul_Hossler]

Did not do any formatting, but easy enough to have each LOB's SubLOBs on separate sheet

Quick look at your WB looks like you'd need total of 3 PTs, you can leave them on hidden sheet and just update source data

This POC only uses one PT for one type of your report




Option Explicit


Sub Demo2()
Dim r As Range
Dim collLOB As Collection, collLOBSubLOB As Collection
Dim i As Long
Dim v As Variant
Dim pt As PivotTable

Set r = Worksheets("Consolidated").Cells(1, 1).CurrentRegion

Set collLOB = New Collection
Set collLOBSubLOB = New Collection




'get list of just LOBs and LOB+SubLOBs
For i = 2 To r.Rows.Count
On Error Resume Next
collLOB.Add r.Cells(i, 4).Value, r.Cells(i, 4).Value
collLOBSubLOB.Add r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value, r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value
On Error GoTo 0
Next i


'delete existing LOB WS and make new LOB WS
For i = 1 To collLOB.Count
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(collLOB.Item(i)).Delete
Application.DisplayAlerts = True
On Error GoTo 0

Worksheets.Add.Name = collLOB.Item(i)
Next

Set pt = Worksheets("Temp1").PivotTables(1)


'do LOB totals
For i = 1 To collLOB.Count
pt.PivotFields("LOB").ClearAllFilters
pt.PivotFields("LOB").CurrentPage = collLOB.Item(i)
pt.PivotFields("Sub LOB").ClearAllFilters


Call MyProcessing(pt, collLOB.Item(i), "Overall")
Next i

'do SubLOB totals
For i = 1 To collLOBSubLOB.Count
v = Split(collLOBSubLOB.Item(i), Chr(1))
pt.PivotFields("LOB").ClearAllFilters
pt.PivotFields("LOB").CurrentPage = v(0)
pt.PivotFields("Sub LOB").ClearAllFilters
pt.PivotFields("Sub LOB").CurrentPage = v(1)


Call MyProcessing(pt, CStr(v(0)), CStr(v(1)))
Next i
End Sub


Sub MyProcessing(myPT As PivotTable, sLOB As String, sTitle As String)
Dim r As Range

Set r = myPT.TableRange1

With Worksheets(sLOB)

.Cells(.Rows.Count, 2).End(xlUp).Offset(3, 0).Value = sTitle

r.Copy .Cells(.Rows.Count, 2).End(xlUp).Offset(2, 0)

End With
End Sub

[jazz2409]

Hi Paul, I think this is so advanced I can't seem to understand how the pivot table looked like it. Please help me understand it so I'll know how to apply it to my project..

[jazz2409]

Hi Paul, I was able to combine p45cal's codes with yours and it's working now. Just one question though.
How do I change the font size of each sTitle? I can't make it to work

[Paul_Hossler]

Using my macro as an example, change and add the lines in bold



Sub MyProcessing(myPT As PivotTable, sLOB As String, sTitle As String)
Dim r As Range

Set r = myPT.TableRange1

With Worksheets(sLOB)


With .Cells(.Rows.Count, 2).End(xlUp).Offset(3, 0)
.Value = sTitle
.Font.Size = "12"
.Font.Bold = True
.Font.Underline = True
End With

r.Copy .Cells(.Rows.Count, 2).End(xlUp).Offset(2, 0)

End With
End Sub

[jazz2409]

Using my macro as an example, change and add the lines in bold



Sub MyProcessing(myPT As PivotTable, sLOB As String, sTitle As String)
Dim r As Range

Set r = myPT.TableRange1

With Worksheets(sLOB)


With .Cells(.Rows.Count, 2).End(xlUp).Offset(3, 0)
.Value = sTitle
.Font.Size = "12"
.Font.Bold = True
.Font.Underline = True
End With

r.Copy .Cells(.Rows.Count, 2).End(xlUp).Offset(2, 0)

End With
End Sub




So I was in the right direction. Thank you :)
I have a quesetion, though. For example, Main LOB 1 has 5 Sub LOBs. However 2 of its Sub LOBs don't have data in Consolidated Sheet yet. How do I make the other 2 Sub LOBs still show a table of their own? So far it only shoes what's in the Consolidated Sheet. Is that possible?

[Paul_Hossler]

Anything is possible (well, almost anything)

I'd consolidate data onto the Consolidated sheet first using another (new?) macro

[jazz2409]

hmm okay..
By the way how do I add this:

.TableStyle = "TableStyleMedium14"

[Paul_Hossler]

Many times I'll use the macro recorder to generate a snippet of code:


Macro1 is for pivot tables, Macro2 is for ListObjects (aka Tables), and MacroFinal is using the snippet from Macro2 to do all Tables on the Activesheet




Option Explicit


Sub Macro1()
'
' Macro1 Macro
'


'
ActiveSheet.PivotTables("PivotTable2").TableStyle2 = "PivotStyleMedium14"
End Sub
Sub Macro2()
'
' Macro2 Macro
'


'
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium14"
End Sub






Sub MacroFinal()
Dim i As Long

For i = 1 To ActiveSheet.ListObjects.Count
ActiveSheet.ListObjects(i).TableStyle = "TableStyleMedium14"
Next i

End Sub

[jazz2409]

Marking this thread as solved. Thank you, Paul. :)

[jazz2409]

Hi Paul, my apologies I am having an issue regarding this code. I am applying conditional formatting to every table and my code relies heavily on the tables being in a list. How do I make the tables that are being created by your code be in a list?

[Paul_Hossler]

Hi Paul, my apologies I am having an issue regarding this code. I am applying conditional formatting to every table and my code relies heavily on the tables being in a list. How do I make the tables that are being created by your code be in a list?


What do you mean by 'List'? An array of ListObject names?

[jazz2409]

What do you mean by 'List'? An array of ListObject names?

Yes. Like MyTable as ListObject something like that

[Paul_Hossler]

Do the names need to be in an array? MacroFinal in #22 does all on a worksheet (can be expanded to all worksheets)

[jazz2409]

I'm honestly not sure.. Based on p45cal's code:


Set myTable = NewSht.ListObjects.Add(xlSrcRange, Destn1.Resize(.Rows.Count, .Columns.Count), , xlYes

I am using myTable as reference for getting the column name. Something like myTable.ListColumns("ColumnName") etc

[Paul_Hossler]

One way




Option Explicit


Dim aryListObjects(1 To 100) As ListObject
Dim cntListObjects As Long


Sub Demo2()
Dim r As Range
Dim collLOB As Collection, collLOBSubLOB As Collection
Dim i As Long
Dim v As Variant
Dim pt As PivotTable

Set r = Worksheets("Consolidated").Cells(1, 1).CurrentRegion

Set collLOB = New Collection
Set collLOBSubLOB = New Collection




'get list of just LOBs
For i = 2 To r.Rows.Count
On Error Resume Next
collLOB.Add r.Cells(i, 4).Value, r.Cells(i, 4).Value
collLOBSubLOB.Add r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value, r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value
On Error GoTo 0
Next i


'delete existing LOB WS and make new LOB WS
For i = 1 To collLOB.Count
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(collLOB.Item(i)).Delete
Application.DisplayAlerts = True
On Error GoTo 0

Worksheets.Add.Name = collLOB.Item(i)
Next

Set pt = Worksheets("Temp1").PivotTables(1)
cntListObjects = 0




'do LOB
For i = 1 To collLOB.Count
pt.PivotFields("LOB").ClearAllFilters
pt.PivotFields("LOB").CurrentPage = collLOB.Item(i)
pt.PivotFields("Sub LOB").ClearAllFilters


Call MyProcessing(pt, collLOB.Item(i), "Overall")
Next i

'do SubLOB
For i = 1 To collLOBSubLOB.Count
v = Split(collLOBSubLOB.Item(i), Chr(1))
pt.PivotFields("LOB").ClearAllFilters
pt.PivotFields("LOB").CurrentPage = v(0)
pt.PivotFields("Sub LOB").ClearAllFilters
pt.PivotFields("Sub LOB").CurrentPage = v(1)


Call MyProcessing(pt, CStr(v(0)), CStr(v(1)))
Next i


'do something with the array
For i = 1 To cntListObjects
aryListObjects(i).TableStyle = "TableStyleMedium15"
Next i


End Sub








Sub MyProcessing(myPT As PivotTable, sLOB As String, sTitle As String)
Dim r As Range, r2 As Range

Set r = myPT.TableRange1
cntListObjects = cntListObjects + 1

With Worksheets(sLOB)

Set r2 = .Cells(.Rows.Count, 2).End(xlUp).Offset(3, 0)
r2.Value = sTitle

Set r2 = .Cells(.Rows.Count, 2).End(xlUp).Offset(2, 0)
r.Copy r2

Set r2 = r2.CurrentRegion

'make range into ListOject and add to array
.ListObjects.Add(xlSrcRange, r2, , xlYes).Name = sLOB & "_" & sTitle

Set aryListObjects(cntListObjects) = .ListObjects(sLOB & "_" & sTitle)

End With
End Sub

[jazz2409]

I'm getting an error
25918

[jazz2409]

Yeah it works. Sorry my fault... Marking this as solved.. Can we delete the other thread? I was thinking it's a different thing so I made another thread