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
Bookmarks