• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Create pivot table in an existing sheet

Asingham

New Member
Hello,


---------------------------------------------------------------------------------------

Purpose: Using a macro, I would like to create a pivot table from input source; but in an existing sheet

---------------------------------------------------------------------------------------

Couple of Requirements:

(1) I will always have a sheet created by name "YourPivotTables" in the same workbook that serves as a destination to this newly created pivot table

(2) I would like to erase the contents in this sheet before new pivot table gets created

(3) The input data gets changed once in 2 weeks - different rows, but same columns

---------------------------------------------------------------------------------------

What I did:

Sub CreatePivot()
' Creates a PivotTable report by using the PivotTableWizard method
' with the PivotFields method to specify the fields in the PivotTable.

Dim objTable As PivotTable, ObjField As PivotField

' Select the sheet and first cell of the table that contains the data.
ActiveWorkbook.Sheets("Input Data").Select Range("B1").Select

Worksheets("YourPivotTables").Select
Cells.Delete

On Error GoTo errhandler

' Create the PivotTable object based on the Input data.
Set objTable = Sheet6.PivotTableWizard(xlDatabase, Range("B1"), _
"YourPivotTables", "Proposal Counts")

' Specify row and column fields.
Set ObjField = objTable.PivotFields("Product")
ObjField.Orientation = xlRowField
ObjField.Position = 1
ObjField.PivotItems("AE").Visible = True
ObjField.PivotItems("Eng").Visible = True
ObjField.PivotItems("EngPI").Visible = True
ObjField.PivotItems("Plant").Visible = True
ObjField.PivotItems("PlantPI").Visible = True
ObjField.PivotItems("PGS").Visible = True
ObjField.PivotItems("(blank)").Visible = False
ObjField.PivotItems("EngPI").Position = 1
ObjField.PivotItems("PlantPI").Position = 2
ObjField.PivotItems("PGS").Position = 3
ObjField.EnableMultiplePageItems = True

' Specify a data field with its summary
' function and format.
Set ObjField = objTable.PivotFields("New Unit Value")
ObjField.Orientation = xlDataField
ObjField.Function = xlAverage
ObjField.NumberFormat = " #,##0"

' Specify a page field.
Set ObjField = objTable.PivotFields("Proposal Status")
ObjField.Orientation = xlPageField
ObjField.PivotItems("Quoted-Budget").Visible = True
ObjField.PivotItems("Quoted-Firm w/ Spec").Visible = True
ObjField.PivotItems("Quoted-Firm w/o Spec").Visible = True
ObjField.PivotItems("Quoted-Perf Only").Visible = True
ObjField.PivotItems("Accessory Quote").Visible = False
ObjField.PivotItems("Engineering Review").Visible = False
ObjField.PivotItems("Feasiblity Review").Visible = False
ObjField.PivotItems("No Bid").Visible = False
ObjField.PivotItems("On Hold").Visible = False
ObjField.PivotItems("Remove Eng Review").Visible = False
ObjField.PivotItems("(blank)").Visible = False
ObjField.PivotItems("Received").Visible = True
ObjField.EnableMultiplePageItems = True

Set ObjField = objTable.PivotFields("New Unit Value")
ObjField.Orientation = xlPageField
ObjField.PivotItems("(blank)").Visible = False
ObjField.PivotItems("$").Visible = False
ObjField.EnableMultiplePageItems = True

errhandler:
If Err.Number <> 0 Then
Select Case Err.Description
Case "Unable to get the PivotItems property of the PivotField class": Resume Next
Case Else: MsgBox "Something went wrong: Error#" & Err.Number & vbCrLf & _ Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End Select
End If

Application.DisplayAlerts = True

End Sub

---------------------------------------------------------------------------------------

Issues:

Error mesg: Method'PivotTableWizard' of object '_Worksheet' failed

---------------------------------------------------------------------------------------


Can some one please help me where my code is having an issue? Thanks in advance!
 
I'm guessing the problem lies with the fact that the range in the below line of code is for just one cell:

Set objTable = Sheet6.PivotTableWizard(xlDatabase, Range("B1"), "YourPivotTables", "Proposal Counts")


If you are using Excel 2007 or later, I suggest you change your data source into an Excel Table (using the Cntl T shortcut in Excel 2010). Then make a note of it's name (it will probably be called Table1) and use that in your code. THat way, you never have to adjust the range again...Excel always uses the whole table to create or update your pivots.


Here's how I do it:`

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= "Table1", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination :="Sheet1!R1C1"

`
 
Thanks Jeff. I tried giving the exact range and also creating a table and giving that in the range. Still the same error.


ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= "Table1", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination :="Sheet1!R1C1"


The above code may work, but I don't know how to add rows, columns, page field and pivot items from that..so I'm trying to use my existing code and make little modifications.
 
the problem with your above code remains this line:

Set objTable = Sheet6.PivotTableWizard(xlDatabase, Range("B1"), _

"YourPivotTables", "Proposal Counts")


At http://msdn.microsoft.com/en-us/library/office/aa191874%28v=office.10%29.aspx you can see the arguments that vba is looking for:


PivotTableWizard(SourceType, SourceData, TableDestination, TableName, RowGrand, ColumnGrand, SaveData, HasAutoFormat, AutoPage, Reserved, BackgroundQuery, OptimizeCache, PageFieldOrder, PageFieldWrapCount, ReadData, Connection)


(Note that you don't have to supply all of them)


So you have Range("B1") as the SourceData argument. Change this to the name of the table you created e.g. Range("Table1") (You may have already done this)

And you have "YourPivotTables" as the TableDestination argument. But VBA wants a range to put the table in, not a sheetname. Change this to SheetX.Range("SomeCellReference") where:

* SheetX is the sheet CODE name (you get this from the VBA editor. Check out http://datapigtechnologies.com/blog/index.php/avoiding-excel-vba-errors-caused-by-changing-worksheet-names/ for info on the difference between sheet code names and sheet names.

* SomeCellReference is either a cell address (e.g. "A1") or (ideally) a named range you've set up pointing to a cell address (e.g. "Output")
 
A couple of other pointers:

1. You very rarely need to select anything in VBA in order to do something with it. Selecting objects takes up time, so don't do it unless you need to.


For instance, you don't need this at all:

' Select the sheet and first cell of the table that contains the data.

ActiveWorkbook.Sheets("Input Data").Select Range("B1").Select


...and you can change this:

Worksheets("YourPivotTables").Select

Cells.Delete


...to this:

Worksheets("YourPivotTables").Cells.Delete


2. On that last example, rather than clearing the entire sheet, it would be better to just clear the range containing the pivottable. If you know the pivottable name, you can just do something like this:

Worksheets("YourPivotTables").PivotTables("Proposal Counts").TableRange2.Clear


...or if there is just one pivottable in the sheet, you can use the number 1 (it's Index Number )instead of its name:

Worksheets("YourPivotTables").PivotTables(1).TableRange2.Clear


3. You don't have to set the .Visible property of pivotitems to Visible...this is the default. So you can delete any lines where you do this: ObjField.PivotItems("SomePivotItem").Visible = True


...You only need to keep the ones that set .Visible to False, e.g.

ObjField.PivotItems("(blank)").Visible = False

ObjField.PivotItems("Accessory Quote").Visible = False

...etc.


4. Instead of fully referencing each object in each line like this:

ObjField.PivotItems("(blank)").Visible = False

ObjField.PivotItems("EngPI").Position = 1

ObjField.PivotItems("PlantPI").Position = 2

ObjField.PivotItems("PGS").Position = 3


...you can do this:

With ObjField

.PivotItems("(blank)").Visible = False

.PivotItems("EngPI").Position = 1

.PivotItems("PlantPI").Position = 2

.PivotItems("PGS").Position = 3

.SomeOtherAction = SomeOtherSetting


End With


...which is more efficient.


5. I don't think you need this line:

ObjField.EnableMultiplePageItems = True

...because that only applies to page fields, and this is a rowfield. Unless you have an old version of Excel, in which case that MAY be needed (I can't recall).


6. I'm not sure why you need this:

Application.DisplayAlerts = True

...usually this is in code where someone is say deleting a sheet, and doesn't want the user to be alerted by the "Do you want to delete this sheet" message.
 
Thanks Jeff for sharing valuable insights. I made changes to the code. Shown below is that:

--------------------------------------------------------------------------------------

Sub MakePivotsAdvanced()


Dim DataRange As Range

Dim Destination As Range


On Error GoTo errhandler


Worksheets("Pivot Tables Sheet").Cells.Delete


' set data range for pivot tables

Set DataRange = Worksheets("Input Data").Range("B1")


Worksheets("Input Data").Select


'set destination for pivot table

Set Destination = Worksheets("Your Pivot Tables").Range("E1")


Worksheets("Input Data").Select


'create pivot table

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=DataRange, _

TableDestination:=Destination, TableName:="ProposalCounts"


'add row and data fields for pivot table

With Sheets("Your Pivot Tables").PivotTables("ProposalCounts")


.PivotFields("Product").Orientation = xlRowField

.PivotFields("Product").Position = 1


End With


With Sheets("Your Pivot Tables").PivotTables("ProposalCounts").PivotFields("Product")

.PivotItems("AE").Visible = True

.PivotItems("Eng").Visible = True

.PivotItems("EngPI").Visible = True

.PivotItems("Plant").Visible = True

.PivotItems("PlantPI").Visible = True

.PivotItems("PGS").Visible = True

.PivotItems("(blank)").Visible = False

.PivotItems("EngPI").Position = 1

.PivotItems("PlantPI").Position = 2

.PivotItems("PGS").Position = 3


End With


' Specify a data field with its summary

' function and format.


With Sheets("Your Pivot Tables").PivotTables("ProposalCounts")

.PivotFields("New Unit Value").Orientation = xlDataField

.PivotFields("New Unit Value").Function = xlAverage


End With


' Specify a page field.

With Sheets("Your Pivot Tables").PivotTables("ProposalCounts")

.PivotFields("Proposal Status").Orientation = xlPageField


End With


With Sheets("Your Pivot Tables").PivotTables("ProposalCounts").PivotFields("Proposal Status")

.PivotItems("Quoted-Budget").Visible = True

.PivotItems("Quoted-Firm w/ Spec").Visible = True

.PivotItems("Quoted-Firm w/o Spec").Visible = True

.PivotItems("Quoted-Perf Only").Visible = True

.PivotItems("Accessory Quote").Visible = False

.PivotItems("Engineering Review").Visible = False

.PivotItems("Feasiblity Review").Visible = False

.PivotItems("No Bid").Visible = False

.PivotItems("On Hold").Visible = False

.PivotItems("Remove Eng Review").Visible = False

.PivotItems("(blank)").Visible = False

.PivotItems("Received").Visible = True


End With


With Sheets("Your Pivot Tables").PivotTables("ProposalCounts")

.PivotFields("New Unit Value").Orientation = xlPageField


End With


With Sheets("Your Pivot Tables").PivotTables("ProposalCounts").PivotFields("New Unit Value")


.PivotItems("(blank)").Visible = False

.PivotItems("$").Visible = False


End With

errhandler:

If Err.Number <> 0 Then

Select Case Err.Description

Case "Unable to get the PivotItems property of the PivotField class": Resume Next

Case Else: MsgBox "Whoops, something went wrong: Error#" & Err.Number & vbCrLf & Err.Description _

, vbCritical, "Error", Err.HelpFile, Err.HelpContext

End Select

End If

End Sub

---------------------------------------------------------------------------------------

Issues:


(1) ' set data range for pivot tables

Set DataRange = Worksheets("Input Data").Range("B1")


There are currently 3350 rows in the "Input Data" sheet. The first row is blank, which is purposefully left. There are columns till AW. The data has first row as headers.


I'm using Excel 2007 on Windows XP machine.


I tried creating a table as you said:

Insert Table -> $B$1:$AW$3350 ->Unchecked Check box that says "My Tables has headers". If I select that, it is not selecting my headers when creating the pivot table and hence giving error. Then I Clicked OK.

Then edited the table name from Table2 to "InputDataTable".


Gave this table name in the code again like this:

----------------------------------------------------------------

Set DataRange = Worksheets("Input Data").Range("InputDataTable")

----------------------------------------------------------------


It created a pivot table. But,

(a) when I copy paste few extra rows to verify whether the table is dynamically expanding, the answer is NO

(b) When I deleted couple of rows from the table, the table is resizing automatically


(2) I tried with the below code for getting the range for dynamic allocation:


ActiveWorkbook.Names.Add Name:="PvtData", RefersToR1C1:= _

"=OFFSET('Input Data'!R1C2,0,0,COUNTA('Input Data'!C2),COUNTA('Input Data'!R1))"


The code created a defined name "PvtData" and it has the below reference:

=OFFSET('Input Data'!$B$1,0,0,COUNTA('Input Data'!$B:$B),COUNTA('Input Data'!$1:$1))


Issue: Here this reference didnt consider the bottom 4 rows from its range. Don't know why!


Code where I used this PvtData is shown below:

--------------------------------------------------------------------------------------

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:="PvtData", _

TableDestination:=Destination, TableName:="ProposalCounts"

--------------------------------------------------------------------------------------

Issue: When I ran this, I received the error message as shown below:

The PivotTable Field name is not valid. To create a PivotTable report, you must use the data that is organized as a list with labeled columns. If you are changing the name of the PivotTable field, you must type a new name for the field.


I verified from the name manager that this PvtData is in fact selecting the column headers required. I don't know where I'm going wrong.


---------------

(3) There is another issue that I'm looking for some guidance:


If I don't specify the FUNCTION for the PivotField, by default it is considering the COUNTS. What should I specify if i want to get the AVERAGE ? My code is like this:


With Sheets("Your PivotTables").PivotTables("ProposalCounts")

.PivotFields("New Unit Value").Orientation = xlDataField

.PivotFields("New Unit Value").Function = xlAverage


End With


I ended up getting the error message:


---------------

Unable to set the Function Property of the PivotField class

---------------


Kindly suggest!
 
"when I copy paste few extra rows to verify whether the table is dynamically expanding, the answer is NO." – If you are copying entire worksheet rows, then the table doesn’t expand automatically. But if you are copying a block of data (i.e. NOT the entire row) then it should resize.

You can resize the table yourself either by the Resize Table icon from the Table Tools/Design tab that appears when the table is selected, or by dragging the little corner mark at the bottom right hand cell border down the rows you need.

Don’t use OFFSET. Use the tables.


On point 3), the best thing to do is to fire up the macro recorder, change it to Average, and look at the code this generates.


You’ll get something like this:

[pre]
Code:
Sub Macro1()
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Units")
.Caption = "Average of Units"
.Function = xlAverage
End With
End Sub
[/pre]
…which shows that the problem is that Excel refers to datafields by using “Sum of…” or “Average of…”


So just add the words “Sum of” to your existing code, and it should work.
 
The problem with your existing code:

[pre]
Code:
With Sheets("Your PivotTables").PivotTables("ProposalCounts")
.PivotFields("New Unit Value").Orientation = xlDataField
.PivotFields("New Unit Value").Function = xlAverage
End With
...was that as soon as the 2nd line changed the orientation to a data field, the pivot name effectively changes to "Sum of New Unit Value"

And because your WITH block refers to the pivottable, but not this specific pivotfield, Excel misses this change.


IF you change you WITH block to refer to the pivotfield too, then it should work:

With Sheets("Your PivotTables").PivotTables("ProposalCounts")
.PivotFields("New Unit Value").Orientation = xlDataField
.PivotFields("New Unit Value").Function = xlAverage
End With
[/pre]
 
For the Dynamic Table issue,


I need to copy paste the entire data from a database to the existing sheet "Input Data". Saying that, I need all the columns for a row, but not part of the row.


Considering this case, I "think" creating a dynamic table is not a feasible solution.


Please let me know if anyone has any further suggestions on this. Thanks in advance
 
You can still use tables. When I said "If you are copying entire worksheet rows, then the table doesn’t expand automatically" I mean that the table doesn't expand if you say copy the entire sheet row D:D in your source book to the bottom line of your table.


Let me clarify this further. Say your source data you want to copy is in the range "A10:Z300" on sheet 3.

You can copy the range "A10:Z300" to the bottom of your table, and the table should autoexpand.

But if you copy the range 10:300 (i.e. the entire rows) to the row below your table, then the table probably won't
autoexpand. That said, it's simple to resize the table, either manually or with code (e.g. ActiveSheet.ListObjects("Table1").Resize Range("$A$1:$B$400")


How are you currently copying the data? Via code? (And if so, can you post the code here so I can show you how to amend it?) Or via Oa refreshable query? Or by manually cutting and pasting?


What kind of database is it coming from? A relational database (e.g. Access, SQL Server) or a database stored in an Excel sheet somewhere?
 
The source is an excel sheet which has exactly 5 columns as required for building the 2 pivot tables.


First row carries the header data, which is essential in building the pivot tables.

Some times the source Data ranges from A1:E3500. Sometimes the data extends beyond this range.

User deletes data excluding the headers in the existing workbook named "Input Data".

User exports the source data from a tool as an excel workbook by name Source Data

User copies the data from this workbook Source Data excluding the header i.e in this case from B1:E3500 and pastes it to Input Data


If the pasted data is within the range of the initially created table, there are no issues. The issue is when the new data goes beyond the initial range, the table is not automatically expanding.


I would like to minimize the manual effort in resizing the table range. Saying that, as soon as the user copy pastes the data, he hits the create report button and the report will create two pivot tables using this updated input data.
 
Back
Top