Below is the code for a Sub Procedure that creates a Pivot Table. I posted
previously about the Base Item, but had a death in the family at the time
and wasn't able to get back on this project until recently. What I want to
be able to do is have the Base Item be the last date in the Weekending date
from an exported "Database". When I right click on the Data Field and
chose field it places the date as the first date, under (previous) and
(next). As a result the date is the first entry in the column field as
well as the last. Giving me a division error on the row data.

Also, I want to be able to create a second Pivot Table on the same
worksheet, based on the same Pivot Cache. I can create both separately, but
want a single macro to create both. Any help or information from the group
would be appreciated.

Joel Mills



Sub CreatePivotTable()

Dim PTCache As PivotCache
Dim PT As PivotTable
Dim strLastItem
Dim rngPivotData As Range
Set rngPivotData = Sheets("Data").Range("Database")
strLastItem = rngPivotData.Cells(rngPivotData.Rows.Count, 1).Value

Application.ScreenUpdating = False

Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase,
SourceData:= _
"Database")

On Error GoTo PivotError

Set PT = PTCache.CreatePivotTable(TableDestination:="",
TableName:="PercentTable")

On Error GoTo 0

With PT
.PivotFields("Week Ending").Orientation = xlColumnField
.PivotFields("Target Early % Comp.").Orientation = xlDataField
.PivotFields("Target Late % Comp.").Orientation = xlDataField
.PivotFields("Target Planned % Comp.").Orientation = xlDataField
.ColumnGrand = False
.RowGrand = False

End With

With ActiveSheet.PivotTables("PercentTable").PivotField s( _
"Sum of Target Early % Comp.")
.Calculation = xlPercentOf
.BaseItem = strLastItem
.NumberFormat = "0.00%"
End With

With ActiveSheet.PivotTables("PercentTable").PivotField s( _
"Sum of Target Late % Comp.")
.Calculation = xlPercentOf
.BaseItem = strLastItem
.NumberFormat = "0.00%"
End With

With ActiveSheet.PivotTables("PercentTable").PivotField s( _
"Sum of Target Planned % Comp.")
.Calculation = xlPercentOf
.BaseItem = strLastItem
.NumberFormat = "0.00%"
End With


Application.ScreenUpdating = True

ActiveSheet.Name = "Pivot"
Sheets("Pivot").Move After:=Sheets("Histogram")

Exit Sub

PivotError:
MsgBox "Did you Copy the Export and Run Cleanup?" _
& vbCrLf & "If not then run them before running this Macro"
_
& vbCrLf & " If you have then you must Delete" _
& vbCrLf & "the (Pivot) Worksheet before running this Macro"

End Sub