Solved

Inserting a pivot at a specific spot (named cell)

Posted on 2014-02-12
13
399 Views
Last Modified: 2014-02-20
How do I insert a pivot table at a specific named cell?  The name I am trying to use is: PlaceSecondPivotHere"  The first pivot table creates a sheet1 and puts the pivot table in, however the second needs to go under the first so I insert on existing for the second.. and I named a cell to put it there.

The code is failing to create the second pivot..??  Ln78  it uses the same data source as the first one we are just using a Count on the second instead of a Sum


Sub AddNewPivotTable()
'
    Range("A1").Select
    Range(Selection, Selection.End(xlDown).End(xlToRight)).Name = "PivotTableRange"  'added to set range
    Sheets.Add.Name = "Sheet1"
    Sheets("Sheet1").Activate
    Range("A1").Select
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "PivotTableRange", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Sheet1!R3C1", TableName:="PivotTable3", DefaultVersion _
        :=xlPivotTableVersion12

    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields( _
        "Short Description               ")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("End Date  ")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("End Date  ")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl").CurrentPage = _
        "(All)"
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl")
        .PivotItems("SERVICE PART").Visible = False
        .PivotItems("SERVICE PART  ").Visible = False
    End With
    
    LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
    NextDate = LastSunday + (6 * 7)
    
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl"). _
        EnableMultiplePageItems = True
    ActiveSheet.PivotTables("PivotTable3").PivotFields("End Date  ").PivotFilters. _
        Add Type:=xlBefore, Value1:=NextDate  'Need this to be 6 weeks out from the past Sundays date.
        
    Range("C4").Select
'this date has to be whatever last Sundays date was?
'Used LastSunday set above  this was =41679
    Selection.Group Start:=LastSunday, End:=True, Periods:=Array(False, False, False _
        , True, True, False, False)
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Chairs"
    Range("C2").Select

'find the spot for the second pivot    
    Application.GoTo Reference:="R3C1"
    ActiveCell.Offset(2, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = _
    "=GETPIVOTDATA(""Oper. Qty"",R3C1,""End Date  "",""<"",""Months"",""<"")"
    ActiveCell.Offset(5, -1).Select
    
    ActiveWorkbook.Names.Add Name:="PutSecondPivotHere", RefersTo:=ActiveCell
    
    ' SecondPivotTable Macro
  
        ActiveWorkbook.Worksheets("Sheet1").PivotTables("PivotTable4").PivotCache. _
        CreatePivotTable TableDestination:="PutSecondPivotHere", TableName:="PivotTable4" _
        , DefaultVersion:=xlPivotTableVersion12
    Sheets("Sheet1").Select
    Cells(PutSecondPivotHere).Select
    
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("Basic Matl")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable4").PivotFields( _
        "Short Description               ")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("End Date  ")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
        "PivotTable4").PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("Basic Matl")
        .PivotItems("SERVICE PART").Visible = False
        .PivotItems("SERVICE PART  ").Visible = False
    End With
    ActiveSheet.PivotTables("PivotTable4").PivotFields("End Date  ").PivotFilters. _
        Add Type:=xlBefore, Value1:="3/16/2014"
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("Basic Matl")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("End Date  ")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("Sum of Oper. Qty")
        .Caption = "Count of Oper. Qty"
        .Function = xlCount
    End With
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "goto 2 cells to the right of SecondPivotHere"
    Range("C35").Select
    
    
    
End Sub

Open in new window

0
Comment
Question by:RWayneH
  • 8
  • 5
13 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39853972
Hi,

pls try (you have to have the Sheet name)

ActiveWorkbook.Names.Add Name:="PutSecondPivotHere", RefersTo:=ActiveCell
    
    ' SecondPivotTable Macro
Rng = Right(ActiveWorkbook.Names("PutSecondPivotHere").RefersToR1C1, Len(ActiveWorkbook.Names("PutSecondPivotHere").RefersToR1C1) - 1)

        ActiveWorkbook.Worksheets("Sheet1").PivotTables("PivotTable4").PivotCache. _
        CreatePivotTable TableDestination:=Rng, TableName:="PivotTable4" _
        , DefaultVersion:=xlPivotTableVersion12

Open in new window

Regards
0
 

Author Comment

by:RWayneH
ID: 39854063
failing on Ln 6, 7, and 8.  Also after this there is a:
Sheets("Sheet1").Select
Cells(36, 1).Select

Isn't the 36, 1 an absolute value?  -R-
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39854079
Hi,

it' is the same principle for  "PivotTableRange", it looks for a string like that
SheetName!R1C1

eg
"Sheet1!R2C1:R3C2"

Open in new window

Regards
0
 

Author Comment

by:RWayneH
ID: 39854098
not following this... what edits are necessary to Ln 6 7 and 8? or Is the edit somewhere else? -R-
0
 

Author Comment

by:RWayneH
ID: 39854115
is it because PutSecondPivotHere refers to   .RefersToR1C1  ?   In the rng  =   What is the trailing -1)  ?  confusing to me.  -R-
0
 

Author Comment

by:RWayneH
ID: 39854484
Need help rewriting to include fixes.  Not sure why failing. -R-
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:RWayneH
ID: 39855742
Need help incorporating edits.. please. -R-
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39855764
Could you send sample dummy?
0
 

Author Comment

by:RWayneH
ID: 39856441
Here is a sample file..  I need to stack 4 pivot tables on top of each other.  The position of the first pivot is static, but I have to determine a specific spot where the next one goes in.

Here is the code that produces the first one and second one, the issue is removing the absolute values that are in the second one, so I can use it to place the third and forth one.

Sub AddNewPivotTable()
'
    Range("A1").Select
    Range(Selection, Selection.End(xlDown).End(xlToRight)).Name = "PivotTableRange"  'added to set range
    Sheets.Add.Name = "Sheet1"
    Sheets("Sheet1").Activate
    Range("A1").Select
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "PivotTableRange", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Sheet1!R3C1", TableName:="PivotTable3", DefaultVersion _
        :=xlPivotTableVersion12

    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields( _
        "Short Description               ")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("End Date  ")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("End Date  ")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl").CurrentPage = _
        "(All)"
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl")
        .PivotItems("SERVICE PART").Visible = False
        .PivotItems("SERVICE PART  ").Visible = False
    End With
    
    LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
    NextDate = LastSunday + (6 * 7)
    
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Basic Matl"). _
        EnableMultiplePageItems = True
    ActiveSheet.PivotTables("PivotTable3").PivotFields("End Date  ").PivotFilters. _
        Add Type:=xlBefore, Value1:=NextDate  'Need this to be 6 weeks out from the past Sundays date.
        
    Range("C4").Select
'this date has to be whatever last Sundays date was?
'Used LastSunday set above  this was =41679
    Selection.Group Start:=LastSunday, End:=True, Periods:=Array(False, False, False _
        , True, True, False, False)
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Chairs"
    Range("C2").Select
    
    Application.Goto Reference:="R3C1"
    ActiveCell.Offset(2, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = _
    "=GETPIVOTDATA(""Oper. Qty"",R3C1,""End Date  "",""<"",""Months"",""<"")"
    ActiveCell.Offset(5, -1).Select
    
    ActiveWorkbook.Names.Add Name:="PutSecondPivotHere", RefersTo:=ActiveCell
    
    ' SecondPivotTable Macro
    
'rng = Right(ActiveWorkbook.Names("PutSecondPivotHere"). _
'RefersToR1C1, Len(ActiveWorkbook.Names("PutSecondPivotHere").RefersToR1C1) - 1)
'
'        ActiveWorkbook.Worksheets("Sheet1").PivotTables("PivotTable5").PivotCache. _
'        CreatePivotTable TableDestination:=rng, TableName:="PivotTable5" _
'        , DefaultVersion:=xlPivotTableVersion12

'Works, trying to remove the absolute values "Sheet1!R36C1" and Cells(36, 1).Select
    ActiveWorkbook.Worksheets("Sheet1").PivotTables("PivotTable3").PivotCache. _
        CreatePivotTable TableDestination:="Sheet1!R36C1", TableName:="PivotTable5" _
        , DefaultVersion:=xlPivotTableVersion12
    Sheets("Sheet1").Select
    Cells(36, 1).Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Basic Matl")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
        "Short Description               ")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("End Date  ")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Oper. Qty")
        .Caption = "Count of Oper. Qty"
        .Function = xlCount
    End With
        
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Basic Matl")
        .PivotItems("SERVICE PART").Visible = False
        .PivotItems("SERVICE PART  ").Visible = False
    End With
    
    LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
    NextDate = LastSunday + (6 * 7)
    
    ActiveSheet.PivotTables("PivotTable5").PivotFields("End Date  ").PivotFilters. _
        Add Type:=xlBefore, Value1:=NextDate
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Basic Matl")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("End Date  ")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    'may need to give this a cell name to get back to this after pivot is made
    Range("D37").Select
    Selection.Group Start:=LastSunday, End:=True, Periods:=Array(False, False, False _
        , True, True, False, False)
    
    Application.Goto Reference:="PutSecondPivotHere"
    ActiveCell.Offset(-2, 2).Select
    ActiveCell.FormulaR1C1 = "Chair Orders"
    
    
End Sub

Open in new window

AddPivotTables.xlsx
0
 
LVL 48

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39856886
HI,

pls try this ( you may revise you GETPIVOTDATA formula)

Pls note that I have almost omitted all Select

Sub AddNewPivotTable()
'
    Range("A1").CurrentRegion.Name = "PivotTableRange"  'added to set range
    Sheets.Add.Name = "Sheet1"
    Sheets("Sheet1").Activate

    SrcRng = Right(ActiveWorkbook.Names("PivotTableRange").RefersToR1C1, Len(ActiveWorkbook.Names("PivotTableRange").RefersToR1C1) - 1)


    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        SrcRng, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Sheet1!R3C1", TableName:="PivotTable3", DefaultVersion _
        :=xlPivotTableVersion12


    With ActiveSheet.PivotTables("PivotTable3")
        With .PivotFields("Basic Matl")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        With .PivotFields("Short Description               ")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlRowField
            .Position = 3
        End With
        .AddDataField .PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
        With .PivotFields("Basic Matl")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlColumnField
            .Position = 1
        End With
        .PivotFields("Basic Matl").CurrentPage = "(All)"
        With .PivotFields("Basic Matl")
            .PivotItems("SERVICE PART").Visible = False
            .PivotItems("SERVICE PART  ").Visible = False
        End With

    
        LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
        NextDate = LastSunday + (6 * 7)
        
        .PivotFields("Basic Matl").EnableMultiplePageItems = True
        .PivotFields("End Date  ").PivotFilters. _
            Add Type:=xlBefore, Value1:=CLng(NextDate)  'Need this to be 6 weeks out from the past Sundays date.
    End With

'this date has to be whatever last Sundays date was?
'Used LastSunday set above  this was =41679
    Range("C4").Group Start:=LastSunday, End:=True, Periods:=Array(False, False, False _
        , True, True, False, False)
    Range("C1").FormulaR1C1 = "Chairs"

    
   
    Range("A" & Rows.Count).End(xlUp).Offset(1, 1).FormulaR1C1 = _
    "=GETPIVOTDATA(""Oper. Qty"",R3C1,""End Date  "",""<"",""Months"",""<"")"
    
    ' SecondPivotTable Macro
    Range("A" & Rows.Count).End(xlUp).Offset(6, 0).Activate
    ActiveWorkbook.Names.Add Name:="PutSecondPivotHere", RefersTo:=ActiveCell

    
    DestRng = Right(ActiveWorkbook.Names("PutSecondPivotHere"). _
        RefersToR1C1, Len(ActiveWorkbook.Names("PutSecondPivotHere").RefersToR1C1) - 1)

   
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        SrcRng, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:=DestRng, TableName:="PivotTable5", DefaultVersion _
        :=xlPivotTableVersion12

'Works, trying to remove the absolute values "Sheet1!R36C1" and Cells(36, 1).Select
'    ActiveWorkbook.Worksheets("Sheet1").PivotTables("PivotTable3").PivotCache. _
'        CreatePivotTable TableDestination:="Sheet1!R36C1", TableName:="PivotTable5" _
'        , DefaultVersion:=xlPivotTableVersion12
'    Sheets("Sheet1").Select

    With ActiveSheet.PivotTables("PivotTable5")
        With .PivotFields("Basic Matl")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields( "Short Description               ")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlRowField
            .Position = 3
        End With
    
        .AddDataField .PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    
        With .PivotFields("Sum of Oper. Qty")
            .Caption = "Count of Oper. Qty"
            .Function = xlCount
        End With
        
        With .PivotFields("Basic Matl")
            .PivotItems("SERVICE PART").Visible = False
            .PivotItems("SERVICE PART  ").Visible = False
        End With
    
        LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
        NextDate = LastSunday + (6 * 7)
    
        .PivotFields("End Date  ").PivotFilters. _
            Add Type:=xlBefore, Value1:=CLng(NextDate)
        With .PivotFields("Basic Matl")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlColumnField
            .Position = 1
        End With
    End With
    
    Application.Goto Reference:="PutSecondPivotHere"
    ActiveCell.Offset(1, 3).Group Start:=LastSunday, End:=True, _
        Periods:=Array(False, False, False, True, True, False, False)
    

    ActiveCell.Offset(-2, 2).FormulaR1C1 = "Chair Orders"
    
    
End Sub

Open in new window

Regards
AddPivotTablesV1.xlsm
0
 

Author Comment

by:RWayneH
ID: 39861497
Ok. I did some testing and the V1 solution worked, however when I went to place the third and fourth pivots in the sheet (all one underneath each other) the same logic that places the second one under the first one is not working.

Why would I not be able to place a third or fourth pivot under 1 and 2 just as 2 was place under 1?  What am I doing wrg?  Fails on Lns 143 thru 146  and 208 thru 211.

Sub AddNewPivotTableB()  
'
    Range("A1").CurrentRegion.Name = "PivotTableRange"  'added to set range
    Sheets.Add.Name = "Sheet1"
    Sheets("Sheet1").Activate

    SrcRng = Right(ActiveWorkbook.Names("PivotTableRange").RefersToR1C1, Len(ActiveWorkbook.Names("PivotTableRange").RefersToR1C1) - 1)


    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        SrcRng, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Sheet1!R3C1", TableName:="PivotTable3", DefaultVersion _
        :=xlPivotTableVersion12


    With ActiveSheet.PivotTables("PivotTable3")
        With .PivotFields("Basic Matl")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        With .PivotFields("Short Description               ")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlRowField
            .Position = 3
        End With
        .AddDataField .PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
        With .PivotFields("Basic Matl")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlColumnField
            .Position = 1
        End With
        .PivotFields("Basic Matl").CurrentPage = "(All)"
        With .PivotFields("Basic Matl")
            .PivotItems("SERVICE PART").Visible = False
            .PivotItems("SERVICE PART  ").Visible = False
        End With

    
        LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
        NextDate = LastSunday + (6 * 7)
        
        .PivotFields("Basic Matl").EnableMultiplePageItems = True
        .PivotFields("End Date  ").PivotFilters. _
            Add Type:=xlBefore, Value1:=CLng(NextDate)  'Need this to be 6 weeks out from the past Sundays date.
    End With

'this date has to be whatever last Sundays date was?
'Used LastSunday set above  this was =41679
    Range("C4").Group Start:=LastSunday, End:=True, Periods:=Array(False, False, False _
        , True, True, False, False)
    Range("C1").FormulaR1C1 = "Chairs"

    
   
    Range("A" & Rows.Count).End(xlUp).Offset(1, 1).FormulaR1C1 = _
    "=GETPIVOTDATA(""Oper. Qty"",R3C1,""End Date  "",""<"",""Months"",""<"")"
    
'******************************************************
' SecondPivotTable Macro
    
'Place the second pivot 5 row down from first one
    Range("A" & Rows.Count).End(xlUp).Offset(5, 0).Activate
'Name the cell "PutSecondPivotHere" to reference in pivot
    ActiveWorkbook.Names.Add Name:="PutSecondPivotHere", RefersTo:=ActiveCell

'Define DestRng using "PutSecondPivotHere" twice
    DestRng = Right(ActiveWorkbook.Names("PutSecondPivotHere"). _
        RefersToR1C1, Len(ActiveWorkbook.Names("PutSecondPivotHere").RefersToR1C1) - 1)
'Used SrcRng (from above Pivot1) and DestRng from defination 2 lines up
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        SrcRng, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:=DestRng, TableName:="PivotTable5", DefaultVersion _
        :=xlPivotTableVersion12

    With ActiveSheet.PivotTables("PivotTable5")
        With .PivotFields("Basic Matl")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("Short Description               ")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlRowField
            .Position = 3
        End With
    
        .AddDataField .PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    
        With .PivotFields("Sum of Oper. Qty")
            .Caption = "Count of Oper. Qty"
            .Function = xlCount
        End With
        
        With .PivotFields("Basic Matl")
            .PivotItems("SERVICE PART").Visible = False
            .PivotItems("SERVICE PART  ").Visible = False
        End With
    
        LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
        NextDate = LastSunday + (6 * 7)
    
        .PivotFields("End Date  ").PivotFilters. _
            Add Type:=xlBefore, Value1:=CLng(NextDate)
        With .PivotFields("Basic Matl")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("End Date  ")
            .Orientation = xlColumnField
            .Position = 1
        End With
    End With
    
    Application.Goto Reference:="PutSecondPivotHere"
    ActiveCell.Offset(1, 3).Group Start:=LastSunday, End:=True, _
        Periods:=Array(False, False, False, True, True, False, False)

    ActiveCell.Offset(-2, 2).FormulaR1C1 = "Chair Orders"
    
'Second Pivot done.  Start third.


'Place the third pivot 5 row down from second one
    Range("A" & Rows.Count).End(xlUp).Offset(5, 0).Activate
'Name the cell "PutThirdPivotHere" to reference in pivot
    ActiveWorkbook.Names.Add Name:="PutThirdPivotHere", RefersTo:=ActiveCell

'Define DestRng using "PutThirdPivotHere" twice
    DestRng = Right(ActiveWorkbook.Names("PutThirdPivotHere"). _
        RefersToR1C1, Len(ActiveWorkbook.Names("PutThirdPivotHere").RefersToR1C1) - 1)
'Used SrcRng (from above Pivot1) and DestRng from defination 2 lines up
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        SrcRng, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:=DestRng, TableName:="PivotTable10", DefaultVersion _
        :=xlPivotTableVersion12
        
    With ActiveSheet.PivotTables("PivotTable10").PivotFields("Basic Matl")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Short Description               ")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable10").PivotFields("End Date  ")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable10").AddDataField ActiveSheet.PivotTables( _
        "PivotTable10").PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    With ActiveSheet.PivotTables("PivotTable10").PivotFields("Basic Matl")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable10").PivotFields("End Date  ")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
        LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
        NextDate = LastSunday + (6 * 7)
    
    ActiveSheet.PivotTables("PivotTable10").PivotFields("End Date  ").PivotFilters. _
            Add Type:=xlBefore, Value1:=CLng(NextDate)
    
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Basic Matl").CurrentPage = _
        "(All)"
    With ActiveSheet.PivotTables("PivotTable10").PivotFields("Basic Matl")
        .PivotItems("CUSTOM/SPECIAL").Visible = False
        .PivotItems("STANDARD      ").Visible = False
    End With
    
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Basic Matl"). _
        EnableMultiplePageItems = True
        
    
    Application.Goto Reference:="PutThirdPivotHere"
    ActiveCell.Offset(1, 3).Group Start:=LastSunday, End:=True, _
        Periods:=Array(False, False, False, True, True, False, False)

    ActiveCell.Offset(-2, 2).FormulaR1C1 = "Service Parts"
 
 'Third Pivot done.
 '********************************
 'Fourth  Pivot
 
 'Place the third pivot 5 row down from second one
    Range("A" & Rows.Count).End(xlUp).Offset(5, 0).Activate
'Name the cell "PutForthPivotHere" to reference in pivot
    ActiveWorkbook.Names.Add Name:="PutForthPivotHere", RefersTo:=ActiveCell

'Define DestRng using "PutForthPivotHere" twice
    DestRng = Right(ActiveWorkbook.Names("PutForthPivotHere"). _
        RefersToR1C1, Len(ActiveWorkbook.Names("PutForthPivotHere").RefersToR1C1) - 1)
'Used SrcRng (from above Pivot1) and DestRng from defination 2 lines up
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        SrcRng, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:=DestRng, TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion12
 
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Basic Matl")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Basic Matl")
        .PivotItems("CUSTOM/SPECIAL").Visible = False
        .PivotItems("STANDARD      ").Visible = False
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields( _
        "Short Description               ")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("End Date  ")
        .Orientation = xlRowField
        .Position = 3
    End With
    
'        LastSunday = Date - Application.WorksheetFunction.Weekday(Date) + 1
'        NextDate = LastSunday + (6 * 7)
               
    ActiveSheet.PivotTables("PivotTable2").PivotFields("End Date  ").PivotFilters. _
            Add Type:=xlBefore, Value1:=CLng(NextDate)
    
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Oper. Qty"), "Sum of Oper. Qty", xlSum
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of Oper. Qty")
        .Caption = "Count of Oper. Qty"
        .Function = xlCount
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Basic Matl")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("End Date  ")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    Application.Goto Reference:="PutThirdPivotHere"
    ActiveCell.Offset(1, 3).Group Start:=LastSunday, End:=True, _
        Periods:=Array(False, False, False, True, True, False, False)
    
    ActiveCell.FormulaR1C1 = "Service Orders"
    Range("A1").Select

End Sub

Open in new window

0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39862366
on the 4th Pivot table you use inconsistent names

PivotTable1 and PivotTable2

Regards
0
 

Author Closing Comment

by:RWayneH
ID: 39875486
Thanks -R-
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now