Vijay P
asked on
Pivot Table Creation with refrence value another sheet
Dear experts,
Need to add pivot table as mentioned in below table with another sheet data range.
item Pivot DataFields
Date xlRowField
Time xlRowField
Band xlColumnField
Pencil xlDataField xlSum
Eraser xlDataField xlAverage
Paper xlDataField xlAverage
Note xlDataField xlSum
i am getting error in below lines
pf.Orientation = MyArray(iCount, 2)
pf.Function = MyArray(iCount, 3).Value
complete code
Dim pt As PivotTable
'The array is declared as a Variant, so it can contain
'different data types like e.g. numbers and tekst.
Dim MyArray(1 To 10, 1 To 3) As Variant
Dim rRange As Range
Dim iCount As Integer
Dim iCount2 As Integer
'We set our range = cell A1:A10
Set rRange = sheets("Sheet2").Range("A1 :A10")
'Values are read from cell A1:A10 and to the right.
For iCount = 1 To 10
With rRange.Item(iCount)
MyArray(iCount, 1) = .Value
MyArray(iCount, 2) = .Offset(0, 1).Value
MyArray(iCount, 3) = .Offset(0, 2).Value
End With
Next
Dim pf As PivotField
Set pt = ActiveSheet.PivotTables(1)
'We now write the values back to the spreadsheet, but in reversed order.
For iCount = 10 To 1 Step -1
iCount2 = iCount2 + 1
With rRange.Item(iCount2)
For Each pf In pt.PivotFields
If pf.Name = MyArray(iCount, 1) Then
pf.Orientation = MyArray(iCount, 2)
pf.Function = MyArray(iCount, 3).Value
End If
Next pf
End With
Next
Set rRange = Nothing
error.JPG
Need to add pivot table as mentioned in below table with another sheet data range.
item Pivot DataFields
Date xlRowField
Time xlRowField
Band xlColumnField
Pencil xlDataField xlSum
Eraser xlDataField xlAverage
Paper xlDataField xlAverage
Note xlDataField xlSum
i am getting error in below lines
pf.Orientation = MyArray(iCount, 2)
pf.Function = MyArray(iCount, 3).Value
complete code
Dim pt As PivotTable
'The array is declared as a Variant, so it can contain
'different data types like e.g. numbers and tekst.
Dim MyArray(1 To 10, 1 To 3) As Variant
Dim rRange As Range
Dim iCount As Integer
Dim iCount2 As Integer
'We set our range = cell A1:A10
Set rRange = sheets("Sheet2").Range("A1
'Values are read from cell A1:A10 and to the right.
For iCount = 1 To 10
With rRange.Item(iCount)
MyArray(iCount, 1) = .Value
MyArray(iCount, 2) = .Offset(0, 1).Value
MyArray(iCount, 3) = .Offset(0, 2).Value
End With
Next
Dim pf As PivotField
Set pt = ActiveSheet.PivotTables(1)
'We now write the values back to the spreadsheet, but in reversed order.
For iCount = 10 To 1 Step -1
iCount2 = iCount2 + 1
With rRange.Item(iCount2)
For Each pf In pt.PivotFields
If pf.Name = MyArray(iCount, 1) Then
pf.Orientation = MyArray(iCount, 2)
pf.Function = MyArray(iCount, 3).Value
End If
Next pf
End With
Next
Set rRange = Nothing
error.JPG
An example workbook will be more help than a picture.
Hi Vijay,
I don't understand what you are trying to achieve, but for your initial require of creating Pivot Table, try below code:
I don't understand what you are trying to achieve, but for your initial require of creating Pivot Table, try below code:
Sub CreatePivotTable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
With Application
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With
'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Sheet2")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="FilteredPivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="FilteredPivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("FilteredPivotTable").PivotFields("Date")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("FilteredPivotTable").PivotFields("Time")
.Orientation = xlRowField
.Position = 2
End With
'Insert Column Fields
With ActiveSheet.PivotTables("FilteredPivotTable").PivotFields("Brand")
.Orientation = xlColumnField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("FilteredPivotTable").PivotFields("Pencil")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "Pencils"
End With
With ActiveSheet.PivotTables("FilteredPivotTable").PivotFields("Eraser")
.Orientation = xlDataField
.Position = 2
.Function = xlAverage
.NumberFormat = "#,##0"
.Name = "Erasers"
End With
With ActiveSheet.PivotTables("FilteredPivotTable").PivotFields("Paper")
.Orientation = xlDataField
.Position = 3
.Function = xlAverage
.NumberFormat = "#,##0"
.Name = "Papers"
End With
With ActiveSheet.PivotTables("FilteredPivotTable").PivotFields("Note")
.Orientation = xlDataField
.Position = 4
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "Notes"
End With
'Format Pivot Table
ActiveSheet.PivotTables("FilteredPivotTable").CompactLayoutRowHeader = "Date & Time"
ActiveSheet.PivotTables("FilteredPivotTable").CompactLayoutColumnHeader = "Brands"
ActiveSheet.PivotTables("FilteredPivotTable").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("FilteredPivotTable").TableStyle2 = "PivotStyleMedium9"
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub
Please find attached sample
Vijay_P-Create-Pivot.xlsm
Vijay_P-Create-Pivot.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.