Results 1 to 14 of 14
  1. #1
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts

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

    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:=xlDa tabase, 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").AddDataFiel d 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

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    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:
    =offset(Sheet1!$A$1,0,0,CountA(Sheet1!$A$1:A$A3000 0),4)
    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.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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.add ress

    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

  4. #4
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts
    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
    Last edited by peterinth; 2011-11-20 at 01:15.

  5. #5
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts
    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:=xlDa tabase, 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??

  6. #6
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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...
    Last edited by sdckapr; 2011-11-20 at 06:41.

  7. #7
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts
    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:=xlD atabase, SourceData:=Database, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion14
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDa tabase, 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").AddDataFiel d ActiveSheet.PivotTables("PivotTable1").PivotFields ("Total Achievement Points"), "Sum of Total Achievement Points", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataFiel d ActiveSheet.PivotTables("PivotTable1").PivotFields ("Total Behaviour Points"), "Sum of Total Behaviour Points", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataFiel d 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.PivotT ables("PivotTable1"), "Name").Slicers.Add ActiveSheet, , "Name", "Name", 120.75, 332.25, 144, 198.75
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotT ables("PivotTable1"), "Year").Slicers.Add ActiveSheet, , "Year", "Year", 158.25, 369.75, 144, 198.75
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotT ables("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

  8. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    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.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  9. #9
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts
    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:=xlDa tabase, SourceData:=Range("$A$1:$F$" & LastRow), Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:="Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion14
    Sheets("Sheet2").Select
    Cells(3, 1).Select
    Last edited by peterinth; 2011-11-21 at 00:36.

  10. #10
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Peter,

    Glad you got it to work. The extra spaces when you paste code can be avoided by enclosing the code in [code] [/code] tags.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  11. #11
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts
    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
    Regards,
    Rory

    Microsoft MVP - Excel

  12. #12
    New Lounger
    Join Date
    Dec 2012
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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.

  13. #13
    New Lounger
    Join Date
    Feb 2013
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Need Help on Pivot Table

    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.

  14. #14
    New Lounger
    Join Date
    Feb 2013
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •