Log in

View Full Version : Need to Filter Content of a Sum Column in a Pivot Table



BigBadBill
08-13-2013, 03:03 PM
The macro below works flawlessly insofar as it makes a pretty data tab, sorts the data into easy to access chunks and creates a column (L) that segregates the business units into either one of the 5 I'm interested in or marks them as No Data. Now, what I need to happen is that I need to be able to filter out No Data from the Target column in the Sum section of the pivot table. But I also need the gross totals for comparison. Thus the two sum columns in this pivot table.

It really seems like PivotItem = False should do the trick but when I try that (attempts marked out in the macro) I get wonderful error messages. I do not want wonderful error messages.

I had to cut out some unnecessary data to get the file size down, thus the blank columns. Anyway, let me know what I'm missing here.

1133


Sub JimMacro()

ActiveSheet.Name = "Data"
Sheets("Data").Activate
Range("D:D").Replace What:="Completed_e-Learning", Replacement:="Yes"
Range("D:D").Replace What:="", Replacement:="No"
Cells.Replace What:="R1", Replacement:="R1 - East"
Cells.Replace What:="R2", Replacement:="R2 - South"
Cells.Replace What:="R3", Replacement:="R3 - Central"
Cells.Replace What:="R4", Replacement:="R4 - West"
Cells.Replace What:="R5", Replacement:="R5 - Corporate"
Cells.Select
Cells.EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.AutoFilter
Dim i As Long, S As String
Range("L1") = "Target"
For i = 2 To Range("J" & Rows.Count).End(xlUp).row
S = Range("J" & i)
If S = "BGWO" Or S = "DOVJ" Or S = "DOVK" Or S = "DOVL" Or S = "DOWK" Then
Range("L" & i) = S
Else: Range("L" & i) = "No Data": End If
Next i

Dim PTCache As PivotCache
Dim PT As PivotTable

Set PTCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:="'" & Activesheet.Name & "'!" & Range("A1").CurrentRegion.Address(true,true,xlR1C1))

Worksheets.Add

Set PT = ActiveSheet.PivotTables.Add( _
PivotCache:=PTCache, _
TableDestination:=Range("A3"))

With PT
.PivotFields("Description").Orientation = xlPageField
'.PivotFields("Target").Orientation = xlColumnField
'.PivotItems("No Data").Visible = False
.PivotFields("Completion Status").Orientation = xlColumnField
.PivotFields("Area").Orientation = xlRowField
.PivotFields("Business Unit").Orientation = xlRowField
.PivotFields("Target").Orientation = xlDataField
'.PivotItems("No Data").Visible = False
.PivotFields("Completion Status").Orientation = xlDataField

.DisplayFieldCaptions = False
End With
ActiveSheet.Name = "Pivot Table"

End Sub

Admin
08-13-2013, 05:32 PM
Hi

Try this one.


Option Explicit

Sub JimMacro()

Dim wksData As Worksheet
Dim LastRow As Long
Dim rngData As Range

Application.ScreenUpdating = False

Set wksData = ActiveSheet
wksData.Name = "Data"

With wksData
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rngData = .Range("a1:l" & LastRow)
End With

With rngData
.Columns(4).Replace What:="Completed_e-Learning", Replacement:="Yes"
.Columns(4).Replace What:="", Replacement:="No"
.Replace What:="R1", Replacement:="R1 - East"
.Replace What:="R2", Replacement:="R2 - South"
.Replace What:="R3", Replacement:="R3 - Central"
.Replace What:="R4", Replacement:="R4 - West"
.Replace What:="R5", Replacement:="R5 - Corporate"
.EntireColumn.AutoFit
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Rows(1).Font.Bold = True
.Rows(1).Interior.Color = 65535
.Range("L1") = "Target"
.Range("l2:l" & LastRow).Formula = "=IF(OR(J2={""BGWO"",""DOVJ"",""DOVK"",""DOVL"",""DOWK""}),J2,""No Data"")"
.Range("l2:l" & LastRow) = .Range("l2:l" & LastRow).Value2
.Name = "PivotRange"
End With

Dim PTCache As PivotCache
Dim PT As PivotTable

Set PTCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, SourceData:=Range("PivotRange").Address(True, True, xlR1C1))

Worksheets.Add

Set PT = ActiveSheet.PivotTables.Add( _
PivotCache:=PTCache, _
TableDestination:=Range("A3"))

With PT
.PivotFields("Description").Orientation = xlPageField
.PivotFields("Completion Status").Orientation = xlColumnField
.PivotFields("Area").Orientation = xlRowField
.PivotFields("Business Unit").Orientation = xlRowField
.PivotFields("Target").Orientation = xlDataField
.PivotFields("Completion Status").Orientation = xlDataField
.PivotFields("Target").Orientation = xlPageField
.PivotFields("Target").PivotItems("No Data").Visible = False
.DisplayFieldCaptions = False
End With
ActiveSheet.Name = "Pivot Table"

Application.ScreenUpdating = True

End Sub

BigBadBill
08-13-2013, 06:12 PM
So close. Whereas before I only got the totals from Completion Status, now I'm only getting the totals from Target. I need both.

That being said, thanks for helping out with my pivot item, that's going to come in handy real soon.