Unable to get the PivotFields property of the PivotTable class

[ashish002]

Hi All,

Facing issue with creating pivot table in loop. It's giving error: "Unable to get the PivotFields property of the PivotTable class"

Here's the code:

Sub PivotTableLoop()

Dim ws As Worksheet
Dim PivC As PivotCache
Dim PivT As PivotTable
Dim Table As ListObject

For Each ws In ActiveWorkbook.Worksheets

Set PivC = Nothing
Set PivT = Nothing
Set Table = Nothing

On Error Resume Next
' Set PivotTable Cache
Set PivC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ws.ListObjects(1), Version:=xlPivotTableVersion15)

' Create the PivotTable
Set PivT = ws.PivotTables.Add(PivotCache:=PivC, _
TableDestination:=ws.Range("w2"), TableName:="PivotTable" & ws.Index)
On Error GoTo 0

For Each PivT In ws.PivotTables

PivT.PivotFields("brands").Orientation = xlRowField
PivT.PivotFields("date").Orientation = xlColumnField
PivT.PivotFields("score").Orientation = xlDataField


Next PivT


Next ws

End Sub

I also want to add a function to summarize the score by Max (xlMax) to the above code. Any help would be appreciated.

 

[Alex Blakenburg]

You are looping through every sheet and the code then assumes that every sheet that has at least 1 table on it will have the 1st table with columns with the labels brand, date and score. Is that actually the case ?
I can only get that error if the table does not have matching column heading in List Object 1 or the worksheet being processed.

To add a field with Max of Score add the line in red in the below:

    For Each PivT In ws.PivotTables
        PivT.PivotFields("brands").Orientation = xlRowField
        PivT.PivotFields("date").Orientation = xlColumnField
        PivT.PivotFields("score").Orientation = xlDataField
        ' Add Max of Score field
        PivT.AddDataField PivT.PivotFields("score"), "Max of score", xlMax
    Next PivT

 

[ashish002]

You are looping through every sheet and the code then assumes that every sheet that has at least 1 table on it will have the 1st table with columns with the labels brand, date and score. Is that actually the case ?
I can only get that error if the table does not have matching column heading in List Object 1 or the worksheet being processed.

To add a field with Max of Score add the line in red in the below:

    For Each PivT In ws.PivotTables
        PivT.PivotFields("brands").Orientation = xlRowField
        PivT.PivotFields("date").Orientation = xlColumnField
        PivT.PivotFields("score").Orientation = xlDataField
        ' Add Max of Score field
        PivT.AddDataField PivT.PivotFields("score"), "Max of score", xlMax
    Next PivT

Yes, the code has to loop through each sheet and create pivot table for the mentioned 3 columns. I ran this in another workbook and it worked perfect along with the code for max of score. Is something wrong with the code, which breaks it when i run it in another workbook?

Also, is there any way (vba/macro) to copy only the pivot tables created in each sheet and paste into a new workbook (separate sheet)?

Thanks again for your time.

 

[Alex Blakenburg]

It relies on each sheet that has at least 1 table on it, that the 1st table on the sheet has those exact field names.

 

[ashish002]

It relies on each sheet that has at least 1 table on it, that the 1st table on the sheet has those exact field names.

Thanks, this solved my problem.

If possible, please do share vba code to copy a range to new workbook.

 

[Alex Blakenburg]

I have logged off for the night. If you start a new thread since it a new topic, someone might come back to you in your time zone. If you leave a link to the new thread here, I will have a look tomorrow if it hasn't been answered yet.

 

[ashish002]

Thanks for your help. Much Appreciated. Here's the link to the new thread.

Copy Paste Data from every sheet to Another Workbook with sheet name using VBA

Hi All, I am looking to copy paste a data (Range W2:BB1000) from each sheet to a new workbook along with sheet names from the source workbook. Eg: If Book1.xlsx has 3 worksheets -> US, UK, CA then the code should copy the range as mentioned above in each worksheet and paste in to new workbook...

www.mrexcel.com

 

[ashish002]

Hi Alex,

Do you see any error in this code? I received response on the other thread but it doesn't seem to work. I am getting runtime error 91 "Object variable or With block variable not set". Please help.

Sub CopySheets()

Dim wb As Workbook, nam As String, i As Long
Dim twb As Workbook: Set twb = ThisWorkbook
Dim ws As Object: Set ws = Worksheets

Application.ScreenUpdating = False
nam = twb.Name
Set wb = Workbooks.Add
twb.Activate
For i = 1 To ws.Count
ws(i).Range("W2:BB1000").Copy wb.ActiveSheet.Range("W2")
wb.ActiveSheet.Name = ws(i).Name
If i = ws.Count Then
twb.Activate
Application.ScreenUpdating = True
MsgBox "Operation Complete"
Exit Sub
End If
wb.ActiveSheet.Next.Activate
Next
MsgBox "Operation Complete"
Application.ScreenUpdating = True

End Sub