Add all fields to pivot using VBA

[JimmyA]

Hi Guys

I need a macro to create a pivot table for multiple columns. I need column A
and B as Row Fields. Colums C to column x (variable) need to be added
automatically as Pivot fields. The headers for column C to x will be variable.

thanks in advance...

 

[JMay]

Have you tried Recording a Macro to see what it provides you with?
Macro Recorder is your friend...

 

[JimmyA]

The number of columns from C onwards can be variable so recording isn't
appropriate

 

[slarbie]

Jmay's suggestion actually is a good one. Even if you can't record the exact
final result you want, you can use the recorder to see the correctly coded
syntax for talking to a pivot table through VBA code. Then modify with some
variables and looping to account for how many columns need to be added, and
you're essentially there. Added bonus of being a great way to build your own
VB skills!

 

[JimmyA]

Slarbie/JMay, got a tight deadline on this. I use loops from time to time but
not sure how to pick up the field and set as variable then loop till last
column (within the pivot VB code) . There can be anything from 60 -80
columns. have you got any example loops to pick up the header, add as data
field then move to next column until completed?

Thanks for the quick responses guys

 

[Dave Peterson]

I used column A to determine the number of rows that should be included in the
pivottable range. And I used Row 1 to determine the number of columns.

I assume that the headers are all nicely valid--no duplicates and no blanks,
right. And that you want Sum for each of those other fields.

Option Explicit
Sub testme()

Dim myRng As Range
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim iCol As Long
Dim RowFieldArray() As String
Dim DataFieldArray() As String
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

With wks
.Activate
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 3 'skipping columns A and B
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

Set myRng = .Range("A1", .Cells(LastRow, LastCol))

ReDim RowFieldArray(1 To 3)
RowFieldArray(1) = .Range("a1").Value
RowFieldArray(2) = .Range("b1").Value
RowFieldArray(3) = "Data"

ReDim DataFieldArray(3 To LastCol)
For iCol = 3 To LastCol
DataFieldArray(iCol) = .Cells(1, iCol).Value
Next iCol

.Parent.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=myRng.Address(external:=True)).CreatePivotTable _
TableDestination:="", _
TableName:="PT" & Format(Now, "yyyymmdd_hhmmss"), _
DefaultVersion:=xlPivotTableVersion10
End With

With ActiveSheet
.PivotTableWizard TableDestination:=.Range("A3")

.PivotTables(1).AddFields RowFields:=RowFieldArray

For iCol = 3 To LastCol
With .PivotTables(1).PivotFields(iCol)
.Orientation = xlDataField
.Position = iCol - 2
.Function = xlSum
End With
Next iCol

With .PivotTables(1).DataPivotField
.Orientation = xlColumnField
.Position = 1
End With

.UsedRange.Columns.AutoFit
.Range("a1").Select 'just to make sure it's visible
.Range("C5").Select
ActiveWindow.FreezePanes = True
End With
End Sub

It seemed to work ok for me in xl2003.

 

[JimmyA]

Thanks Dave, this is exactly what I need. You rule

 

[chaksxl]

Hi ,

I'm very new to this forum. Suddenly this posting attracted me as I'm facing a very simmilar proble while trying to automate a pivot creation through macro, and especially while trying to add multiple datafields into it. I tried the method shown here, but it didn't work for me. The code is getting stuck as the below lines:
"With .PivotTables("DPPivot").PivotFields(iCol)".

May I please get some help here?