Pivot Table VBA Code

B

bmkelly

Board Regular
Joined
Mar 26, 2020
Messages
172
Office Version
  1. 365
Platform
  1. Windows
Hello,

I had followed along with the code in this link Automate Your Pivot Table With VBA [Step By Step Guide] and edited the code to match my data and I can't seem to get it to work. It currently runs thru with no errors but also just creates the PivotTable Sheet and then just leaves the sheet blank.

Here is my code:
VBA Code: 
Sub PT()

'Declare Variables'
    Dim pws As Worksheet
    Dim tws As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long

        On Error Resume Next
    
            Application.DisplayAlerts = False
                Worksheets("PivotTable").Delete
                Sheets.Add Before:=ActiveSheet
                ActiveSheet.Name = "PivotTable"
            Application.DisplayAlerts = True
                Set pws = Worksheets("PivotTable")
                Set tws = Worksheets("Transactions")
        
'Define Data Range'
    LastRow = tws.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = tws.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = tws.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:="Table1")

'Insert Blank Pivot Table'
    Set PTable = PCache.CreatePivotTable _
        (TableDestination:=pws.Cells(1, 1), TableName:="Table1")

'Insert Row Fields'
    With ActiveSheet.PivotTables("Table1").PivotFields("RSQM_Cust_Name")
        .Orientation = xlRowField
        .Position = 1
    End With

'Insert Data Field'
    With ActiveSheet.PivotTables("Table1").PivotFields("Equipment ID")
        .Orientation = xlDataField
        .Position = 1
        .Function = xlCount
        .Name = "Device Count"
    End With

    With ActiveSheet.PivotTables("Table1").PivotFields("BDS Unit Price")
        .Orientation = xlDataField
        .Position = 2
        .Function = xlSum
        .NumberFormat = "#,##0"
        .Name = "Sum of BDS Unit Price"
    End With
    
    With ActiveSheet.PivotTables("Table1").PivotFields("FY22 Impact")
        .Orientation = xlDataField
        .Position = 3
        .Function = xlSum
        .NumberFormat = "#,##0"
        .Name = "Sum of FY22 Impact"
    End With

'Format Pivot'
    TableActiveSheet.PivotTables("Table1").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("Table1").TableStyle2 = "PivotStyleLight16"

End Sub

Here is what I would like the Pivot Table to look like:
FY22 Q2 Q3 (Jul-Dec 21) UNC Hospital Pricing Doc - SM Review.xlsx
ABCD
3Row LabelsSum of BDS Unit PriceSum of FY22 ImpactDevice Count
4UNC Hospitals-CTS$ 50,718.00$ 58,355.034746
5UNC Rockingham Healthcare$ (2,017.48)$ 7,473.66423
6UNC P & A Clinics-CTS$ (78,699.21)$ (53,855.30)398
7UNC Physician Network$ (12,513.85)$ (9,480.65)306
8Chatham Hospital-CTS$ 154.17$ 2,068.03132
9UNC Campus Health Services-CTS$ (25,935.97)$ (22,876.72)105
10UNC DIABETES CARE CENTER$ -$ -2
11Grand Total$ (68,294.34)$ (18,315.96)6112
Pivot
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Rule of thumb:

long chunks of code with on error resume next stuck at the top and no reset are bad code.

Add on error go to 0 after the line that deletes the pivot table sheet, then try the code again.
 
Upvote 0
RoryA said:
Rule of thumb:

long chunks of code with on error resume next stuck at the top and no reset are bad code.

Add on error go to 0 after the line that deletes the pivot table sheet, then try the code again.
Click to expand...
Thanks! I was able to make that update and it now shows me where it is erroring out at and noticing I didn't make an update to PSheet to pws in my variables but still seems to be erroring out here with a Run-time error'13': Type mismatch

VBA Code: 
'Define Pivot Cache'
    Set PCache = ActiveWorkbook.PivotCaches.Create _
        (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
        TableName:="Table1")
 
Last edited:
Upvote 0
To be honest, this code is not great. Some of it doesn’t make sense and there are variables being set and then not used. Give me a few minutes and I’ll post a tidied up version.
 
Upvote 0
RoryA said:
To be honest, this code is not great. Some of it doesn’t make sense and there are variables being set and then not used. Give me a few minutes and I’ll post a tidied up version.
Click to expand...
No worries, I am trying to self teach with VBA and googled Pivot Table VBA code and followed the first link and tried to edit the fields to match my worksheet. Thanks for helping
 
Upvote 0
Try something like this:

VBA Code: 
Sub PT()

'Declare Variables'
    Dim pws As Worksheet
    Dim tws As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
   
   Application.DisplayAlerts = False
   On Error Resume Next
   Worksheets("PivotTable").Delete
   On Error GoTo 0
   Application.DisplayAlerts = True
   
   Set pws = Sheets.Add(Before:=ActiveSheet)
   pws.Name = "PivotTable"
   
   Set tws = Worksheets("Transactions")
       
'Define Data Range'
' use the region from A1
' pivot tables work best with an address in R1C1 format, and the sheet name should be enclosed in single quotes in case of spaces/special characters
    Dim dataAddress As String
   dataAddress = "'" & tws.Name & "'!" & tws.Cells(1, 1).CurrentRegion.Address(ReferenceStyle:=xlR1C1)

'Define Pivot Cache'
   Set PCache = ActiveWorkbook.PivotCaches.Create _
       (SourceType:=xlDatabase, SourceData:=dataAddress)

'Insert Blank Pivot Table'
   Set PTable = PCache.CreatePivotTable _
       (TableDestination:=pws.Cells(1, 1), TableName:="Table1")
       
' hold a reference to the pivot table we just created
   With PTable
   
   'Insert Row Fields'
      With .PivotFields("RSQM_Cust_Name")
          .Orientation = xlRowField
          .Position = 1
      End With

   'Insert Data Fields'
      With .PivotFields("Equipment ID")
          .Orientation = xlDataField
          .Position = 1
          .Function = xlCount
          .Name = "Device Count"
      End With

      With .PivotFields("BDS Unit Price")
          .Orientation = xlDataField
          .Position = 2
          .Function = xlSum
          .NumberFormat = "#,##0"
          .Name = "Sum of BDS Unit Price"
      End With
   
      With .PivotFields("FY22 Impact")
          .Orientation = xlDataField
          .Position = 3
          .Function = xlSum
          .NumberFormat = "#,##0"
          .Name = "Sum of FY22 Impact"
      End With

'Format Pivot'
      .ShowTableStyleRowStripes = True
      .TableStyle2 = "PivotStyleLight16"
      
   End With

End Sub

Any problems or questions about the code, please post back.
 
Upvote 0
Solution
RoryA said:
Try something like this:

VBA Code: 
Sub PT()

'Declare Variables'
    Dim pws As Worksheet
    Dim tws As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
 
   Application.DisplayAlerts = False
   On Error Resume Next
   Worksheets("PivotTable").Delete
   On Error GoTo 0
   Application.DisplayAlerts = True
 
   Set pws = Sheets.Add(Before:=ActiveSheet)
   pws.Name = "PivotTable"
 
   Set tws = Worksheets("Transactions")
     
'Define Data Range'
' use the region from A1
' pivot tables work best with an address in R1C1 format, and the sheet name should be enclosed in single quotes in case of spaces/special characters
    Dim dataAddress As String
   dataAddress = "'" & tws.Name & "'!" & tws.Cells(1, 1).CurrentRegion.Address(ReferenceStyle:=xlR1C1)

'Define Pivot Cache'
   Set PCache = ActiveWorkbook.PivotCaches.Create _
       (SourceType:=xlDatabase, SourceData:=dataAddress)

'Insert Blank Pivot Table'
   Set PTable = PCache.CreatePivotTable _
       (TableDestination:=pws.Cells(1, 1), TableName:="Table1")
     
' hold a reference to the pivot table we just created
   With PTable
 
   'Insert Row Fields'
      With .PivotFields("RSQM_Cust_Name")
          .Orientation = xlRowField
          .Position = 1
      End With

   'Insert Data Fields'
      With .PivotFields("Equipment ID")
          .Orientation = xlDataField
          .Position = 1
          .Function = xlCount
          .Name = "Device Count"
      End With

      With .PivotFields("BDS Unit Price")
          .Orientation = xlDataField
          .Position = 2
          .Function = xlSum
          .NumberFormat = "#,##0"
          .Name = "Sum of BDS Unit Price"
      End With
 
      With .PivotFields("FY22 Impact")
          .Orientation = xlDataField
          .Position = 3
          .Function = xlSum
          .NumberFormat = "#,##0"
          .Name = "Sum of FY22 Impact"
      End With

'Format Pivot'
      .ShowTableStyleRowStripes = True
      .TableStyle2 = "PivotStyleLight16"
    
   End With

End Sub

Any problems or questions about the code, please post back.
Click to expand...
Awesome! The only thing I have a concern is it pulls (blank) for RSQM_Cust_Name in Rows because in the data there is a totals line for BDS Unit Price and FY22 Impact Price and I would like to not include that into the Pivot Table if possible....Outside of that everything worked perfect and just had to add "$" for the NumberFormat in the code and now Sorting from Largest to Smallest in terms of $$$

Test SM Review Pivot Table.xlsx
ABCD
1Values
2Row LabelsDevice CountSum of BDS Unit PriceSum of FY22 Impact
3UNC Hospitals-CTS4746$50,718$58,355
4Chatham Hospital-CTS132$154$2,068
5UNC DIABETES CARE CENTER2$0$0
6UNC Rockingham Healthcare423-$2,017$7,474
7UNC Physician Network306-$12,514-$9,481
8UNC Campus Health Services-CTS105-$25,936-$22,877
9(blank)-$68,294-$18,316
10UNC P & A Clinics-CTS398-$78,699-$53,855
11Grand Total6112-$136,589-$36,632
PivotTable
 
Upvote 0
Try:

VBA Code: 
   'Insert Row Fields'
      With .PivotFields("RSQM_Cust_Name")
          .Orientation = xlRowField
          .Position = 1
          .PivotItems("(blank)").Visible = False
      End With
 
Upvote 0
RoryA said:
Try:

VBA Code: 
   'Insert Row Fields'
      With .PivotFields("RSQM_Cust_Name")
          .Orientation = xlRowField
          .Position = 1
          .PivotItems("(blank)").Visible = False
      End With
Click to expand...
That's perfect! Thank you for the help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
VBA Calculated Field - Subtract Value in Data Field from Value in Row Field
Replies
0
Views
216
th259
T
J
  • Question
VBA macro to create pivot table on sheet2 with data source on sheet1
Replies
9
Views
977
SpillerBD
S
S
  • Solved
VBA to create pivot tables
2
Replies
12
Views
1K
Domenic
D
T
  • Question
VBA Dynamic PivotTable Name
Replies
4
Views
496
th259
T
F
  • Solved
Problems filtering a Pivot Table with VBA
Replies
2
Views
192
Domenic
D

Forum statistics

Threads
1,214,926
Messages
6,122,305
Members
449,079
Latest member
juggernaut24

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top