New pivot table macro hard coding the range – I need a flexible range

Topic

New Reply

Hi. I created a macro recording to create a pivot table and, because it worked well on my test data set, used it in a functional spreadsheet.

Now I discover that the range for the pivot table data is hard coded, not what I wanted as the range is different every time it’s run.

Could you advise me on the code I could take out and what I could include in the recorded macro below please.

Many, many thanks.

Peter

Sub PTCode()
‘
‘ PTCode Macro
‘

‘
Range(“E1”).Select
ActiveCell.FormulaR1C1 = “1”
Range(“E1”).Select
Selection.Copy
Range(“D1”).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Range(“E1”).Select
Application.CutCopyMode = False
Selection.ClearContents
Range(“A1”).Select
Sheets.Add
‘this is where the range is hard coded

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
“Sheet1!R1C1:R455C4″, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=”Sheet2!R3C1″, TableName:=”PivotTable1”, DefaultVersion _
:=xlPivotTableVersion14

Sheets(“Sheet2”).Select
Cells(3, 1).Select
With ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Strand”)
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Name”)
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Resultset”)
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables(“PivotTable1”).AddDataField ActiveSheet.PivotTables( _
“PivotTable1”).PivotFields(“Result”), “Sum of Result”, xlSum
ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Name”).Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Resultset”).Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Strand”).Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Result”).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″).ShowPages PageField:=”Strand”
End Sub

Reply | Quote

Replies

Peter,

Code:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDa  tabase, SourceData:= _
        "Sheet1!R1C1:R455C4", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion14

In the above code replace: Sheet1!R1C1:R455C4 with Database.
Create a new Defined name called: Database with the RefersTo box containing:
[noparse]=offset(Sheet1!$A$1,0,0,CountA(Sheet1!$A$1:A$A3000 0),4)[/noparse]
Note: Change the 3000 in the above to what you think your maximum number of rows will ever be!.

You’ve just created a Dynamic Range name that will auto adjust to the proper number of rows. Remember that this does not allow for blank rows within the range. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Thanks

That will be what I need.

The rows, in real life probably will never be more than 500 and your code is perfect.

Many thanks

Peter

Reply | Quote

Back again!

I tried to create a Name as below:

Sub MakeName()
ActiveWorkbook.Names.Add Name:=”Database”, RefersTo:=”offset(Sheet1!$A$1,0,0,CountA(Sheet1!$A$1:A$A3000 0),4)”
End Sub

Added the reference Database to the SourceData:= (with and without “”)

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=”Database”, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=”Sheet2!R3C1″, TableName:=”PivotTable1″, DefaultVersion:=xlPivotTableVersion14

I get the error Runtime 1004 Reference not valid.

I do run the MakeName sub first and the name and reference is created if I have a look at the names in the worksheet.

I think I’m missing something very basic here??

Reply | Quote

The variable range part of this answeris part of my question, but I don’t think I need all the PivotTable stuff. I just want to take a subtotal (in Col F) whenever the info in Col. B (nameof teacher) changes. Andthis IS a dynamic spreadsheet that will grow as time goes on.
The psuedo code is sota like: IF $B sub n NOT EQUAL TO $B sub n-1 subtotal Col F from the LAST time you subtotaled and print in Cell G sub n.

Reply | Quote

Hello Peter,

Please help me i need a help on a macro that i have recorded.

I am in a great pain for the past 15 days working on that.

Thanks in advance if you can help me in this.

Reply | Quote

It depends on what range you want.

Instead of having the hardcoded:
SourceData:= “Sheet1!R1C1:R455C4”

You could use as sourcedata:
SourceData:= Worksheets(“Sheet1”).range(“A1”).currentregion.address

This will define the range as the currentregion (contiguous range bounded by blank rows/columns) of sheet1 that has A1 in it. This will determine it at runtime. If that is not what you are after you will have to be more specific to us of how you want to tell the macro what the range is…

Steve

Reply | Quote

Your line has some errors in it. Try this one:

Code:

Sub MakeName()
  ActiveWorkbook.Names.Add Name:="Database",  _
    RefersTo:="=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A$1:$A$3000),4)"
End Sub

Steve
PS your pivot table create line works for me if you get rid of the space in xlDatabase…

Reply | Quote

I’m sorry, but it still doesn’t create the PT. It fails at the create pivot table line.

I have pasted the whole code below and if needed I can post the spreadsheet, but I must get this working today!!!

The space in the xlDatabase was a paste error, it wasn’t in the actual code.

Please help

Peter

Sub MakeName()
ActiveWorkbook.Names.Add Name:=”Database”, _
RefersTo:=”=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A$1:$A$3000),4)”
End Sub

Sub AchBehRegTabbed()
‘
‘ AchBehRegTabbed Macro
‘

‘
Range(“G1”).Select
ActiveCell.FormulaR1C1 = “1”
Range(“G1”).Select
Selection.Copy
Range(“D1:F1”).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
Range(“G1”).Select
Application.CutCopyMode = False
Selection.ClearContents
Range(“A1”).Select
Sheets.Add

‘Create extended range to cover maximum rows
‘****************
‘Sheets(“Sheet1″).Select
‘ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Database, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=”Sheet2!R3C1″, TableName:=”PivotTable1″, DefaultVersion:=xlPivotTableVersion14
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Database, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=”Sheet2!R3C1″, TableName:=”PivotTable1”, DefaultVersion:=xlPivotTableVersion14
Sheets(“Sheet2”).Select
Cells(3, 1).Select
With ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Name”)
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables(“PivotTable1”).AddDataField ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Total Achievement Points”), “Sum of Total Achievement Points”, xlSum
ActiveSheet.PivotTables(“PivotTable1”).AddDataField ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Total Behaviour Points”), “Sum of Total Behaviour Points”, xlSum
ActiveSheet.PivotTables(“PivotTable1”).AddDataField ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Total Conduct Points”), “Sum of Total Conduct Points”, xlSum
With ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Reg”)
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables(“PivotTable1″).ShowPages PageField:=”Reg”
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(“Sheet1”).Select
‘Create New Sheet and name it NewSheet
ActiveWorkbook.Worksheets.Add(After:=ActiveSheet).Name = “Dashboard”
‘Sheets.Add After:=Sheets(Sheets.Count)
‘Sheets(“Sheet25”).Select
‘Sheets(“Sheet25”).name = “Dashboard”
Range(“A1”).Select
Sheets(“Sheet2”).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range(“Sheet2!$A$3:$D$323”)
ActiveChart.ShowReportFilterFieldButtons = False
ActiveChart.ShowLegendFieldButtons = False
ActiveChart.ShowAxisFieldButtons = False
ActiveChart.ShowValueFieldButtons = False
ActiveChart.ShowReportFilterFieldButtons = True
ActiveChart.ShowLegendFieldButtons = True
ActiveChart.ShowAxisFieldButtons = True
ActiveChart.ShowValueFieldButtons = True
ActiveChart.ShowAllFieldButtons = False
ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables(“PivotTable1”), “Name”).Slicers.Add ActiveSheet, , “Name”, “Name”, 120.75, 332.25, 144, 198.75
ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables(“PivotTable1”), “Year”).Slicers.Add ActiveSheet, , “Year”, “Year”, 158.25, 369.75, 144, 198.75
ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables(“PivotTable1”), “Reg”).Slicers.Add ActiveSheet, , “Reg”, “Reg”, 195.75, 407.25, 144, 198.75
ActiveSheet.Shapes.Range(Array(“Reg”)).Select
ActiveSheet.Shapes.Range(Array(“Reg”, “Year”)).Select
ActiveSheet.Shapes.Range(Array(“Reg”, “Year”, “Name”)).Select
ActiveSheet.Shapes.Range(Array(“Reg”, “Year”, “Name”, “Chart 1”)).Select
Selection.Cut
Sheets(“Dashboard”).Select
ActiveSheet.Paste
Range(“J6”).Select
ActiveSheet.Shapes.Range(Array(“Name”)).Select
ActiveSheet.Shapes.Range(Array(“Name”, “Year”)).Select
ActiveSheet.Shapes.Range(Array(“Name”, “Year”, “Reg”)).Select
Selection.ShapeRange.IncrementLeft -60
Selection.ShapeRange.IncrementTop 255.75
Range(“F22”).Select
ActiveSheet.Shapes.Range(Array(“Year”)).Select
ActiveSheet.Shapes(“Year”).IncrementLeft 116.25
ActiveSheet.Shapes(“Year”).IncrementTop -39
ActiveSheet.Shapes.Range(Array(“Reg”)).Select
ActiveSheet.Shapes(“Reg”).IncrementLeft 230.25
ActiveSheet.Shapes(“Reg”).IncrementTop -75.75
ActiveSheet.ChartObjects(“Chart 1”).Activate
ActiveSheet.ChartObjects(“Chart 1”).Activate
ActiveSheet.Shapes(“Chart 1”).ScaleWidth 1.2729166667, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(“Chart 1”).ScaleHeight 0.9965277778, msoFalse, msoScaleFromTopLeft
Cells.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveSheet.ChartObjects(“Chart 1”).Activate
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 42
ActiveChart.ClearToMatchStyle
ActiveSheet.Shapes.Range(Array(“Name”)).Select
ActiveSheet.Shapes.Range(Array(“Name”, “Year”)).Select
ActiveSheet.Shapes.Range(Array(“Name”, “Year”, “Reg”)).Select
ActiveWorkbook.SlicerCaches(“Slicer_Name”).Slicers(“Name”).Style = “SlicerStyleDark2”
ActiveWorkbook.SlicerCaches(“Slicer_Year”).Slicers(“Year”).Style = “SlicerStyleDark2”
ActiveWorkbook.SlicerCaches(“Slicer_Reg”).Slicers(“Reg”).Style = “SlicerStyleDark2”
Range(“O8”).Select
End Sub

Reply | Quote

Peter,

My fault. Change: SourceData:=Database to SourceDate:=Range(“Database”).address
Note there are two places you need to do this.
BTW: It’s hard to work on code when you can’t test it out and at my age CRS creeps in a lot. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Thank you so much for your help. One of the reasons it didn’t work was that the focus was on the wrong sheet (Sheet2) immediately before the create pivot table code.
I tried many different methods and came up with the one below.

Again – Many thanks. It’s all a learning experience.

ps
funny how the gap in ‘xlDa tabase’ appears whenever I paste the code in the forum????

‘*********************************************************************************************************
Dim LastRow As Long
LastRow = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row
‘*************************************************************
‘
Range(“G1”).Select
ActiveCell.FormulaR1C1 = “1”
Range(“G1”).Select
Selection.Copy
Range(“D1:F1”).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
Range(“G1”).Select
Application.CutCopyMode = False
Selection.ClearContents
Range(“A1”).Select
Sheets.Add

‘Create extended range to cover maximum rows
‘****************
Sheets(“Sheet1”).Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Range(“$A$1:$F$” & LastRow), Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=”Sheet2!R3C1″, TableName:=”PivotTable1″, DefaultVersion:=xlPivotTableVersion14
Sheets(“Sheet2”).Select
Cells(3, 1).Select

Reply | Quote

Peter,

Glad you got it to work. The extra spaces when you paste code can be avoided by enclosing the code in [noparse][/noparse] tags. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

FWIW, all that selecting and activating is pretty unnecessary – you should be able to use something like:

Code:

Sub AchBehRegTabbed()
'
' AchBehRegTabbed Macro
'
   Dim PC                As Excel.PivotCache
   Dim PT                As Excel.PivotTable
   Dim wksOut            As Excel.Worksheet
   Dim cht               As Excel.Chart
   Dim LastRow           As Long

   LastRow = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row
   With Range("G1")
      .Value = "1"
      .Copy
      Range(Range("D1:F1"), Range("D1:F1").End(xlDown)).PasteSpecial Paste:=xlPasteAll, _
                                 Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
      .ClearContents
   End With
   Set wksOut = Sheets.Add

   'Create extended range to cover maximum rows
   '****************
   Set PC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                              SourceData:=Sheets("Sheet1").Range("$A$1:$F$" & LastRow), _
                                              Version:=xlPivotTableVersion14)

   Set PT = PC.CreatePivotTable(TableDestination:=wks.Cells(3, 1), _
                                TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion14)

   With PT
      With .PivotFields("Name")
         .Orientation = xlRowField
         .Position = 1
      End With
      .AddDataField .PivotFields("Total Achievement Points"), "Sum of Total Achievement Points", xlSum
      .AddDataField .PivotFields("Total Behaviour Points"), "Sum of Total Behaviour Points", xlSum
      .AddDataField .PivotFields("Total Conduct Points"), "Sum of Total Conduct Points", xlSum
      With .PivotFields("Reg")
         .Orientation = xlPageField
         .Position = 1
      End With
      .ShowPages PageField:="Reg"
   End With

   'Create New Sheet and name it Dashboard
   ActiveWorkbook.Worksheets.Add(After:=Sheets("Sheet1")).Name = "Dashboard"
   Set cht = wksOut.Shapes.AddChart.Chart
   With cht
      .ChartType = xlColumnClustered
      .SetSourceData Source:=PT.TableRange1
      .ShowReportFilterFieldButtons = False
      .ShowLegendFieldButtons = False
      .ShowAxisFieldButtons = False
      .ShowValueFieldButtons = False
      .ShowReportFilterFieldButtons = True
      .ShowLegendFieldButtons = True
      .ShowAxisFieldButtons = True
      .ShowValueFieldButtons = True
      .ShowAllFieldButtons = False
   End With
   With ActiveWorkbook.SlicerCaches
      .Add(PT, "Name").Slicers.Add wksOut, , "Name", "Name", 120.75, 332.25, 144, 198.75
      .Add(PT, "Year").Slicers.Add wksOut, , "Year", "Year", 158.25, 369.75, 144, 198.75
      .Add(PT, "Reg").Slicers.Add wksOut, , "Reg", "Reg", 195.75, 407.25, 144, 198.75
   End With
   wksOut.Shapes.Range(Array("Reg", "Year", "Name", "Chart 1")).Cut
   With Sheets("Dashboard")
      .Paste
      With .Shapes.Range(Array("Name", "Year", "Reg"))
         .IncrementLeft -60
         .IncrementTop 255.75
      End With
      With .Shapes("Year")
         .IncrementLeft 116.25
         .IncrementTop -39
      End With
      With .Shapes("Reg")
         .IncrementLeft 230.25
         .IncrementTop -75.75
      End With
      With .Shapes("Chart 1")
         .ScaleWidth 1.2729166667, msoFalse, msoScaleFromTopLeft
         .ScaleHeight 0.9965277778, msoFalse, msoScaleFromTopLeft
      End With
      With .Cells.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorLight1
         .TintAndShade = 0
         .PatternTintAndShade = 0
      End With
      With .ChartObjects("Chart 1").Chart
         .ChartStyle = 42
         .ClearToMatchStyle
      End With
   End With
   With ActiveWorkbook
      .SlicerCaches("Slicer_Name").Slicers("Name").Style = "SlicerStyleDark2"
      .SlicerCaches("Slicer_Year").Slicers("Year").Style = "SlicerStyleDark2"
      .SlicerCaches("Slicer_Reg").Slicers("Reg").Style = "SlicerStyleDark2"
   End With
End Sub

Reply | Quote

I have recorded a Macro which runs and creates a Pivot Table of the data in the excel.

I am facing a issue in this macro is some data is sometimes missing and it gets debug.

Please help in how to skip this data which is missing and the macro should run and create a Pivot Table for the rest of the data.

Reply | Quote