Need to Filter Content of a Sum Column in a Pivot Table

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.

Attachment 1133

Code:

---

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

---

Hi

Try this one.

Code:

---

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

---

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.