Friday, April 7, 2017

Creating a Pivot table using VBA

We are trying to create a vba script, where we are taking input for the Row lable, Column label,  and Value field from a metadata sheet. The Raw data is a separate sheet from which we are generating the pivots.


Below are the steps:




Sub CreatePivot()


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



'Delete Preivous Pivot Table Worksheet & Insert a New Blank


Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Collateral Type Codes").Delete
Sheets("RawData").Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Collateral Type Codes"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Collateral Type Codes")
Set DSheet = Worksheets("RawData")



'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:="MerivalPivotTable")

Dim Col1 As String
Dim Row1 As String
Dim RowArray() As String
Dim ColArray() As String
Dim Value As String
Dim ValueArray() As String
Dim Func

Row1 = Sheets("PivotMetaData").Cells(6, 3).Value
Col1 = Sheets("PivotMetaData").Cells(6, 4).Value
Value = Sheets("PivotMetaData").Cells(6, 5).Value
Func = Sheets("PivotMetaData").Cells(6, 6).Value

RowArray = Split(Row1, ",")
ColArray = Split(Col1, ",")
ValArray = Split(Value, ",")
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="MerivalPivotTable")



'Insert Row Fields


For i = 0 To UBound(RowArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(RowArray(i))
 .Orientation = xlRowField
 .Position = i + 1
End With
Next I



'Insert Column Fields


For j = 0 To UBound(ColArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ColArray(j))
 .Orientation = xlColumnField
 .Position = j + 1
End With
Next j



'Insert Data Field


If Func = "Sum" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlSum
 .NumberFormat = "#,##0"
 End With
Next k
End If



If Func = "Count" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlCount
 .NumberFormat = "#,##0"
 End With
Next k
End If



If Func = "Average" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlAverage
 .NumberFormat = "#,##0"
 End With
Next k
End If



If Func = "Max" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlMax
 .NumberFormat = "#,##0"
End With
Next k
End If



If Func = "Min" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlMin
 .NumberFormat = "#,##0"
End With
Next k
End If



If Func = "Product" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlProduct
 .NumberFormat = "#,##0"
End With
Next k

End If

No comments:

Post a Comment