Help with Pivot Table

[Joel Mills]

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:=xlDatabase,
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").PivotFields( _
"Sum of Target Early % Comp.")
.Calculation = xlPercentOf
.BaseItem = strLastItem
.NumberFormat = "0.00%"
End With

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

With ActiveSheet.PivotTables("PercentTable").PivotFields( _
"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

 

[Debra Dalgleish]

If you're creating the pivot table programmatically, when (and why) are
you right-clicking on the Data field?

In your macro, after you create the first pivot table, you can calculate
its width or height, and start the second pivot table outside that range.

 

[Joel Mills]

I clicked it after the pivot table was created to see why I got a division
error. Hoping it would give me a hint on how to correct the problem.

 

[Debra Dalgleish]

Each date should only appear once in the list. Are you sure the same
date is at the top and bottom of the list?

If you sort the list and/or the date field in the code, does it fix the
problem?

 

[Joel Mills]

The first date looks like this "11/7/2006" and the last date looks like
this: "11/7/06". All of the dates beginning with the second one which is
2/7/06 thru 11/7/06.
Excel must see the first date which is being created by strLastItem as
something different than the other dates.

 

[Joel Mills]

And second part of question. After sorting the data I still have the first
date as 11/7/2006. All others as 2/7/05....11/7/06.

 

[Debra Dalgleish]

Try declaring it as a string, and formatting, e.g. :

Dim strLastItem As String
strLastItem = _
Format(rngPivotData.Cells(rngPivotData.Rows.Count, 1).Value, "m/d/yy")

 

[Joel Mills]

Debra, thankyou for you help. Your suggestion to declare it as a string was
the solution to my problem. I was also able to use your information on the
second pivot table and now have this portion of my project complete.

 

[Debra Dalgleish]

Great! Thanks for letting me know that it solved the problem.

 

[Joel Mills]

I hope others can benefit from this thread. Your perseverance really paid
off for me.