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




Reply With Quote
Bookmarks