Pivot VBA problem

S

Shaner73

Board Regular
Joined
Jul 27, 2010
Messages
65
When running this macro, I get Run-time Error '5': Invalid procedure call or argument. Would anyone be willing to take a look to see if there is an error somewhere in the code?

Debugging shows problem in 'yellow'

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

'
    Range("A2").Select
    Sheets("Pivot table").Select
    Columns("B:D").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Pivot table!R1C2:R1048576C4", Version:=xlPivotTableVersion12). _
        CreatePivotTable TableDestination:="Match Summary!R1C19", TableName:= _
        "PivotTable2", DefaultVersion:=xlPivotTableVersion12
    Sheets("Match Summary").Select
    Cells(1, 19).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("PivotTable2").PivotFields( _
        "MPN (from Customer Demand List)")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Listed Qty"), "Count of Listed Qty", xlCount
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Count of Listed Qty")
        .Caption = "Sum of Total Listed Avail. Qty"
        .Function = xlSum
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Listed Cost"), "Count of Listed Cost", xlCount
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Count of Listed Cost")
        .Caption = "Min of Listed Cost"
        .Function = xlMin
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Listed Cost"), "Count of Listed Cost", xlCount
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Count of Listed Cost")
        .Caption = "Max of Listed Cost"
        .Function = xlMax
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
    Columns("S:V").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("S1:V1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub


This code runs first with no problems...

Rich (BB code): 
Sub EMS_Match_Report()
'
' Macro1 Macro
'

    Application.ScreenUpdating = False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:M").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=3
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:Q").Select
    Columns("Q:U").Select
    Selection.Delete Shift:=xlToLeft
    Columns("U:U").Select
    ActiveWindow.SmallScroll ToRight:=7
    Columns("Y:Y").Select
    ActiveWindow.SmallScroll ToRight:=10
    Columns("Y:AH").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Z:Z").Select
    ActiveWindow.SmallScroll ToRight:=18
    Columns("Z:AM").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-21
    Columns("D:D").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("O:O").Select
    Selection.Cut
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Columns("Q:Q").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight
    Columns("O:O").Select
    Selection.Cut
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    Columns("Q:Q").Select
    Selection.Cut
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("M:M").Select
    Selection.Insert Shift:=xlToRight
    Columns("N:O").Select
    Selection.Cut
    Columns("S:S").Select
    Selection.Insert Shift:=xlToRight
    Columns("Y:Y").Select
    Selection.Cut
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight
    ActiveWindow.SmallScroll ToRight:=-12
    Range("A1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.RowHeight = 119.25
    Cells.Select
    Selection.ColumnWidth = 34
    Cells.EntireColumn.AutoFit
    Cells.EntireColumn.AutoFit
    Columns("A:A").Select
    Selection.ColumnWidth = 18.43
    Columns("A:A").EntireColumn.AutoFit
    Columns("F:M").Select
    Selection.ColumnWidth = 7
    Selection.ColumnWidth = 5.71
    Columns("F:M").EntireColumn.AutoFit
    Columns("N:R").Select
    Selection.ColumnWidth = 5
    Columns("N:R").EntireColumn.AutoFit
    Columns("S:Y").Select
    Columns("S:Y").EntireColumn.AutoFit
    Selection.ColumnWidth = 7.14
    Columns("S:Y").EntireColumn.AutoFit
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Fran $"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("R2").Select
    Columns("R:R").ColumnWidth = 5
    Columns("R:R").EntireColumn.AutoFit
    ActiveWindow.SmallScroll ToRight:=-14
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MPN (from Oppslist)"
    With ActiveCell.Characters(Start:=1, Length:=31).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Cells.Select
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
        "B2:B4877"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A1:CF4877")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("A2").Select '
    Cells.Select
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
        "W2:W4877"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A1:CF4877")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.LargeScroll ToRight:=1
    Columns("W:W").Select
    Selection.Replace What:="AMERICA II ELECTRONICS INC", Replacement:="", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Cells.Select
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
        "A2:A4877"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A1:CF4877")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$CF$4877").RemoveDuplicates Columns:=Array(1, 19, 20, 23 _
        ), Header:=xlNo
    Columns("A:A").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$4881").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B2").Select
    'Range("A2").Select
        'Columns("B:B").Select
    'Range("B2").Activate
    'Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'Range("B1").Select
    'ActiveCell.FormulaR1C1 = "CT"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("B3").Select
  If IsEmpty(ActiveCell) Then Exit Sub
  Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown
  'Start Copy Paste Special
  Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
  'Stop Copy Paste Special
'VLookUp Part
    Sheets(2).Select
    Sheets(2).Name = "Numbers"
    Sheets(1).Select
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Numbers!C[-1]:C,2,FALSE)"
    If IsEmpty(ActiveCell) Then Exit Sub
  Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown
  'Start Copy Paste Special
  Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
  'Stop Copy Paste Special
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "#"
    With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Columns("B:B").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Columns("B:B").Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("A:A").EntireColumn.AutoFit
    Range("A2").Select
    Sheets("Numbers").Select
    ActiveWindow.SelectedSheets.Delete
    Range("A:B,D:F").Select
    Range("D1").Activate
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(D1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10092543
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Columns("G:N").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(G1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Columns("O:S").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(O1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Columns("C:C").Select
    Range("C:C,T:Z").Select
    Range("T1").Activate
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(T1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Range("A2").Select
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A2").Select
    Columns("A:A").Select
    Columns("A:Y").Select
    Sheets(1).Select
    Sheets(1).Copy After:=Sheets(1)
    Sheets(2).Select
    Sheets(2).Copy After:=Sheets(2)
    Sheets(3).Select
    Sheets(3).Name = "Pivot table"
    Sheets(2).Select
    Sheets(2).Name = "Detailed Match"
    Sheets(1).Select
    Sheets(1).Name = "Match Summary"
    Sheets("Match Summary").Select
    With ActiveWorkbook.Sheets("Match Summary").Tab
        .Color = 255
        .TintAndShade = 0
    Application.ScreenUpdating = True
    End With
    Sheets("Pivot Table").Select
    Columns("C:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    Sheets("Match Summary").Select
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    Columns("S:S").Select
    ActiveWindow.SmallScroll ToRight:=9
    Columns("S:Y").Select
    Selection.Delete Shift:=xlToLeft
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Res. Qty"
    Application.ScreenUpdating = TRUE
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A2").Select
    Sheets("Detailed Match").Select
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Res. Qty"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Sheets("Match Summary").Select
    Columns("A:R").Select
    ActiveSheet.Range("$A$1:$R$4881").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A2").Select
End Sub

I will either add the Pivot macro to 1st macro, or just Call it.

Thanks!!!
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
Trying to remember without looking up here....

I think it's something to do with the PivotCache names your table 'PivotTable2', so when you run it again there's already a pivot table with that name.

Same as not being allowed two sheets with the same name. That's why it runs ok first time.
 
Upvote 0
Darren Bartrup said:
Trying to remember without looking up here....

I think it's something to do with the PivotCache names your table 'PivotTable2', so when you run it again there's already a pivot table with that name.

Same as not being allowed two sheets with the same name. That's why it runs ok first time.
Click to expand...

So, do I need to change PivotTable2 to PivotTable3?
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
369
RoryA
RoryA
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
549
kevin9999
K
K
  • Solved
formating question
Replies
3
Views
121
Micron
M
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
298
Coco1
C
N
  • Question
My code is suddenly really slow
Replies
1
Views
178
RobP
R

Forum statistics

Threads
1,216,091
Messages
6,128,779
Members
449,468
Latest member
AGreen17

Share this page

We've detected that you are using an adblocker.

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

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

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

Disable uBlock

Follow these easy steps to disable uBlock

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