VBScript to create pivot for entire data on a tab

bmontoni

New Member
Joined
Mar 1, 2022
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I am trying to write a script to create a pivot table for the entire data set on a tab. When I record it and run the macro on a table with a larger number of rows, the macro set the range to only include the number of rows that existed in the dataset when the pivot was recorded. Can someone please provide me the script to create this pivot using the "last row" function for columns A through F?

Rich (BB code):
Sub prepareMBEWpivot()
'
' prepareMBEWpivot Macro
'

'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R346C7", Version:=7).CreatePivotTable TableDestination:= _
        "Sheet1!R1C10", TableName:="PivotTable1", DefaultVersion:=7
    Sheets("Sheet1").Select
    Cells(1, 10).Select
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("generic")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Article")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Valuation Area")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Standard price"), "Sum of Standard price", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Standard price")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Article").Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("generic").Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Valuation Area").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False _
        )
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Standard price").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False _
        )
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Planned price 1"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Planned price 2"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Planned price 3"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = False
        .RowGrand = False
    End With
    ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
End Sub
 
Last edited by a moderator:

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
First find the last used row using the following code . . .

VBA Code:
    With Worksheets("Sheet1")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

Then replace . . .

VBA Code:
SourceData:="Sheet1!R1C1:R346C7"

with

VBA Code:
SourceData:="Sheet1!R1C1:R" & lastRow & "C7"

However, here's a more efficient way of creating your pivot table . . .

VBA Code:
Sub prepareMBEWpivot()

    'set the source worksheet
    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = Worksheets("Sheet1")
    
    'set the source range
    Dim sourceRange As Range
    Set sourceRange = sourceWorksheet.Range("A1").CurrentRegion
    
    'delete pivot table, if it exists
    On Error Resume Next
    sourceWorksheet.Range("J1").PivotTable.TableRange2.Delete
    On Error GoTo 0
    
    'create the cache
    Dim ptCache As PivotCache
    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sourceRange)
    
    'create the pivot table
    Dim pt As PivotTable
    Set pt = sourceWorksheet.PivotTables.Add(PivotCache:=ptCache, TableDestination:=sourceWorksheet.Range("J1"))
    
    With pt
    
        'set properties
        '
        '
        
        With .PivotCache
            .RefreshOnFileOpen = False
            .MissingItemsLimit = xlMissingItemsDefault
        End With
        
        .RepeatAllLabels xlRepeatLabels
        
        With .PivotFields("generic")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        With .PivotFields("Article")
            .Orientation = xlRowField
            .Position = 2
        End With
        
        'etc
        '
        '
    
    End With
    
End Sub

Hope this helps!
 
Upvote 0
For some reason this script is throwing an error. Is there anyway I could add in the "last row" script into the script I provided. The script I sent has some formatting being done to the pivot that the one you sent did not include.
 
Upvote 0
Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0
For your original macro . . .

VBA Code:
Sub prepareMBEWpivot()
'
' prepareMBEWpivot Macro
'

'
    With Worksheets("Sheet1")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!R1C1:R" & lastRow & "C7", Version:=7).CreatePivotTable TableDestination:= _
    "Sheet1!R1C10", TableName:="PivotTable1", DefaultVersion:=7
    Sheets("Sheet1").Select
    Cells(1, 10).Select
    With ActiveSheet.PivotTables("PivotTable1")
    .ColumnGrand = True
    .HasAutoFormat = True
    .DisplayErrorString = False
    .DisplayNullString = True
    .EnableDrilldown = True
    .ErrorString = ""
    .MergeLabels = False
    .NullString = ""
    .PageFieldOrder = 2
    .PageFieldWrapCount = 0
    .PreserveFormatting = True
    .RowGrand = True
    .SaveData = True
    .PrintTitles = False
    .RepeatItemsOnEachPrintedPage = True
    .TotalsAnnotation = False
    .CompactRowIndent = 1
    .InGridDropZones = False
    .DisplayFieldCaptions = True
    .DisplayMemberPropertyTooltips = False
    .DisplayContextTooltips = True
    .ShowDrillIndicators = True
    .PrintDrillIndicators = False
    .AllowMultipleFilters = False
    .SortUsingCustomLists = True
    .FieldListSortAscending = False
    .ShowValuesRow = False
    .CalculatedMembersInFilters = False
    .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("generic")
    .Orientation = xlRowField
    .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Article")
    .Orientation = xlRowField
    .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Valuation Area")
    .Orientation = xlRowField
    .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
    "PivotTable1").PivotFields("Standard price"), "Sum of Standard price", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Standard price")
    .Orientation = xlPageField
    .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Article").Subtotals = Array _
    (False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("generic").Subtotals = Array _
    (False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Valuation Area").Subtotals _
    = Array(False, False, False, False, False, False, False, False, False, False, False, False _
    )
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Standard price").Subtotals _
    = Array(False, False, False, False, False, False, False, False, False, False, False, False _
    )
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Planned price 1"). _
    Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
    False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Planned price 2"). _
    Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
    False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Planned price 3"). _
    Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
    False, False)
    With ActiveSheet.PivotTables("PivotTable1")
    .ColumnGrand = False
    .RowGrand = False
    End With
    ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    
End Sub

For the re-written version . . .

VBA Code:
Sub prepareMBEWpivot()

    'set the source worksheet
    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = Worksheets("Sheet1")
    
    'set the source range
    Dim sourceRange As Range
    Set sourceRange = sourceWorksheet.Range("A1").CurrentRegion
    
    'delete pivot table, if it exists
    On Error Resume Next
    sourceWorksheet.Range("J1").PivotTable.TableRange2.Delete
    On Error GoTo 0
    
    'create the cache
    Dim ptCache As PivotCache
    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sourceRange)
    
    'create the pivot table
    Dim pt As PivotTable
    Set pt = sourceWorksheet.PivotTables.Add(PivotCache:=ptCache, TableDestination:=sourceWorksheet.Range("J1"))
    
    With pt
    
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
        
        With .PivotCache
            .RefreshOnFileOpen = False
            .MissingItemsLimit = xlMissingItemsDefault
        End With
        
        .RepeatAllLabels xlRepeatLabels
        
        With .PivotFields("generic")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        With .PivotFields("Article")
            .Orientation = xlRowField
            .Position = 2
        End With
        
        With .PivotFields("Valuation Area")
            .Orientation = xlRowField
            .Position = 3
        End With
        
        .AddDataField .PivotFields("Standard price"), "Sum of Standard price", xlSum
        
        With .PivotFields("Standard price")
            .Orientation = xlPageField
            .Position = 1
        End With
        
        .PivotFields("Article").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("generic").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Valuation Area").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Standard price").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Planned price 1").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Planned price 2").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Planned price 3").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .ColumnGrand = False
        .RowGrand = False
        
        .RowAxisLayout xlTabularRow
        .RepeatAllLabels xlRepeatLabels
    
    End With
    
End Sub
 
Upvote 0
Is there a way to name this pivot table so when I run another macro to filter to pivot for a standard cost of 0.00 that macro is able to reference that pivot table name?

If not, is is there a way to add in the step to filter for standard price of 0.00?

This is the code that I am using to filter but the pivot name is always changing so the filtering macro fails

Sub filterMBEWpivot()
'
' filterMBEWpivot Macro
'

'
Range("K1").Select
ActiveSheet.PivotTables("PivotTable4").PivotFields("Standard price"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Standard price"). _
CurrentPage = "0.00"
End Sub
 
Upvote 0
Which macro are you using to create your pivot table?
 
Upvote 0
Which macro are you using to create your pivot table?
Sub prepareMBEWpivot()

'set the source worksheet
Dim sourceWorksheet As Worksheet
Set sourceWorksheet = Worksheets("Sheet1")

'set the source range
Dim sourceRange As Range
Set sourceRange = sourceWorksheet.Range("A1").CurrentRegion

'delete pivot table, if it exists
On Error Resume Next
sourceWorksheet.Range("J1").PivotTable.TableRange2.Delete
On Error GoTo 0

'create the cache
Dim ptCache As PivotCache
Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sourceRange)

'create the pivot table
Dim pt As PivotTable
Set pt = sourceWorksheet.PivotTables.Add(PivotCache:=ptCache, TableDestination:=sourceWorksheet.Range("J1"))

With pt

.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow

With .PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With

.RepeatAllLabels xlRepeatLabels

With .PivotFields("generic")
.Orientation = xlRowField
.Position = 1
End With

With .PivotFields("Article")
.Orientation = xlRowField
.Position = 2
End With

With .PivotFields("Valuation Area")
.Orientation = xlRowField
.Position = 3
End With

.AddDataField .PivotFields("Standard price"), "Sum of Standard price", xlSum

With .PivotFields("Standard price")
.Orientation = xlPageField
.Position = 1
End With

.PivotFields("Article").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

.PivotFields("generic").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

.PivotFields("Valuation Area").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

.PivotFields("Standard price").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

.PivotFields("Planned price 1").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

.PivotFields("Planned price 2").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

.PivotFields("Planned price 3").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

.ColumnGrand = False
.RowGrand = False

.RowAxisLayout xlTabularRow
.RepeatAllLabels xlRepeatLabels

End With

End Sub
 
Upvote 0
You can store the pivot table name in a module-level constant, and then use it to refer to your pivot table within both your procedures. So, for example, try the following . . .

VBA Code:
Option Explicit

Const PT_NAME As String = "MyPivotTableName" 'change the pivot table name as desired

Sub prepareMBEWpivot()

    'set the source worksheet
    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = Worksheets("Sheet1")
    
    'set the source range
    Dim sourceRange As Range
    Set sourceRange = sourceWorksheet.Range("A1").CurrentRegion
    
    'delete pivot table, if it exists
    On Error Resume Next
    sourceWorksheet.PivotTables(PT_NAME).TableRange2.Delete
    On Error GoTo 0
    
    'create the cache
    Dim ptCache As PivotCache
    Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sourceRange)
    
    'create the pivot table
    Dim pt As PivotTable
    Set pt = sourceWorksheet.PivotTables.Add(PivotCache:=ptCache, TableDestination:=sourceWorksheet.Range("J1"), TableName:=PT_NAME)
    
    With pt
    
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
        
        With .PivotCache
            .RefreshOnFileOpen = False
            .MissingItemsLimit = xlMissingItemsDefault
        End With
        
        .RepeatAllLabels xlRepeatLabels
        
        With .PivotFields("generic")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        With .PivotFields("Article")
            .Orientation = xlRowField
            .Position = 2
        End With
        
        With .PivotFields("Valuation Area")
            .Orientation = xlRowField
            .Position = 3
        End With
        
        .AddDataField .PivotFields("Standard price"), "Sum of Standard price", xlSum
        
        With .PivotFields("Standard price")
            .Orientation = xlPageField
            .Position = 1
        End With
        
        .PivotFields("Article").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("generic").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Valuation Area").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Standard price").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Planned price 1").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Planned price 2").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .PivotFields("Planned price 3").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
        .ColumnGrand = False
        .RowGrand = False
        
        .RowAxisLayout xlTabularRow
        .RepeatAllLabels xlRepeatLabels
    
    End With
    
End Sub

Sub filterMBEWpivot()

    'set the source worksheet
    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = Worksheets("Sheet1")

    With sourceWorksheet.PivotTables(PT_NAME).PivotFields("Standard price")
        .ClearAllFilters
        .CurrentPage = "0.00"
    End With

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,223,099
Messages
6,170,112
Members
452,302
Latest member
TaMere

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