Runtime error 5, Invalid Procedure call or argument error when creating a pivot table

VBAProIWish

Well-known Member
Hello All,

I'm trying to record a macro that inserts a pivot table from data from one worksheet onto a newly created worksheet, but I'm getting this error here...

"runtime 5"

"Invalid procedure call or argument"

The code in RED is the code below that it bugs on.

Code:
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet2").Name = "Cht-P"
    Sheets("DB-P").Select
    Range("A1").Select
    Selection.CurrentRegion.Select
[COLOR=red]   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _[/COLOR]
[COLOR=red]       "DB-P!R1C1:R6674C5", Version:=xlPivotTableVersion12).CreatePivotTable _[/COLOR]
[COLOR=red]       TableDestination:="Cht-P!R1C1", TableName:="PivotTable1", _[/COLOR]
[COLOR=red]       DefaultVersion:=xlPivotTableVersion12[/COLOR]
    Sheets("Cht-P").Select
    Cells(1, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Cht-P!$A$1:$C$18")
    ActiveWorkbook.ShowPivotChartActiveFields = True
    ActiveChart.ChartType = xl3DColumnClustered
    ActiveWorkbook.ShowPivotChartActiveFields = False
Can anyone help me fix this?

Thanks much!
 

RoryA

MrExcel MVP, Moderator
You need single quotes around the sheet name due to the hyphen in it:
Code:
TableDestination:="'Cht-P'!R1C1"
 

VBAProIWish

Well-known Member
Wow, who would've thought it would be something that simple.

Logic would tell me that the macro recorder should know that and automatically put a single quotation around sheet names with hyphens in them.

Thanks a bunch rorya! :D
 

kavster

New Member
Hi Rory,

I apologise for posting in the same thread about my problem but I am receiving an identical error to VBAProIWish's. However, my sheet is simply called "Pivot" with no special characters.

Do you have any suggestions?

Cheers!

Kav
 

kavster

New Member
Apologies, here it is:

Code:
Sub CreatePivot()

    Sheets("Data").Activate
    Sheets("Data").Range("B7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Data!R7C2:R526C42", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="pvtLOLvsROL", DefaultVersion _
        :=xlPivotTableVersion12

     With ActiveSheet.PivotTables("pvtLOLvsROL")
    
         .PivotFields("Class")
            .Orientation = xlPageField
            .Position = 1
        
        
         .PivotFields("Year")
            .Orientation = xlPageField
            .Position = 1
        
        
         .PivotFields("Client")
            .Orientation = xlPageField
            .Position = 1
        
        
         .PivotFields("Basis")
            .Orientation = xlPageField
            .Position = 1
        
        
         .PivotFields("Cat Model Version")
            .Orientation = xlPageField
            .Position = 1
        
        
         .PivotFields("Layer Reference")
            .Orientation = xlRowField
            .Position = 1
        
        
         .PivotFields("Layer")
            .Orientation = xlRowField
            .Position = 2
        
        
         .PivotFields("Limit")
            .Orientation = xlRowField
            .Position = 3
        
        
         .PivotFields("Deductible")
            .Orientation = xlRowField
            .Position = 4
        
        
         .PivotFields("LOL Disc")
            .Orientation = xlRowField
            .Position = 5
        
        
         .PivotFields("ROL")
            .Orientation = xlRowField
            .Position = 6
        
        
        .ColumnGrand = False
        .RowGrand = False
        .RowAxisLayout xlTabularRow
        End With
    

    Dim i As Integer
    Dim iFieldMax As Integer
    
    'Find the number of PivotFields
    iFieldMax = ActiveSheet.PivotTables("pvtLOLvsROL").PivotFields.Count
    'Loop through the fields in the Pivot
    For i = 1 To iFieldMax
         With ActiveSheet.PivotTables("pvtLOLvsROL").PivotFields(i)
             'Set subtotal calculation to nothing
            .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        End With
    Next i
    
    Columns("A:M").EntireColumn.AutoFit
    
End Sub
 
Last edited:

kavster

New Member
Managed to fix the issue. The solution needed me to apply the following:

Code:
Sub CreatePivot()

    Sheets("Data").Activate
    Sheets("Data").Range("B7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Data!R7C2:R526C42", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="pvtLOLvsROL", DefaultVersion _
        :=xlPivotTableVersion12

    With ActiveSheet.PivotTables("pvtLOLvsROL")
    
        With .PivotFields("Class")
            .Orientation = xlPageField
            .Position = 1
        End With
        
        With .PivotFields("Year")
            .Orientation = xlPageField
            .Position = 1
        End With
.
.
.
Thanks for your attention anyway!

Kav
 

santhosh2250

New Member
Re: Runtime error 5, Invalid Procedure call or argument error

hey Rorya!!! Could u please help me out, im facing the same error when running following code in outlook vba. throwing error at place marked with red.
Rich (BB code):
Option Explicit
Sub SaveEmailDetails()
        Dim olkMsg As Object, _
            excApp As Object, _
            excWkb As Object, _
            excWks As Object, _
            intRow As Integer, _
            intVersion As Integer, _
            strFilename As String, _
            TextBody As String, _
            Index As Integer, _
            tmpIndex As Integer, _
            strSent As String, _
            subStrSent As String
    
       strFilename = "C:\phani\RespondedMails\" & Format(Now(), "yymmdd hhmmss") & ".xls"
         If strFilename <> "" Then
           ' intVersion = GetOutlookVersion()
            Set excApp = CreateObject("Excel.Application")
            Set excWkb = excApp.Workbooks.Add
            Set excWks = excWkb.ActiveSheet
            'Write Excel Column Headers
          With excWkb
            .Worksheets("Sheet1").Name = "Data"
            With .Worksheets("Data")
                With .Cells(1, 1)
                .Value = "Subject"
                 .Font.Bold = True
                 End With
               With .Cells(1, 2)
               .Value = "Replied at"
               .Font.Bold = True
                 End With
               With .Cells(1, 3)
               .Value = "Received at"
               .Font.Bold = True
                 End With
               With .Cells(1, 4)
               .Value = "Sender"
               .Font.Bold = True
                 End With
               With .Cells(1, 5)
               .Value = "Response Time"
               .Font.Bold = True
                 End With
                .Columns("A").ColumnWidth = 100
                .Columns("B").ColumnWidth = 15
                .Columns("C").ColumnWidth = 15
                .Columns("D").ColumnWidth = 15
                .Columns("E").ColumnWidth = 15
            End With
         End With
            intRow = 2
            'Write messages to spreadsheet
            For Each olkMsg In Application.ActiveExplorer.CurrentFolder.Items
                If olkMsg.Class = olMail Then
                    'Add a row for each field in the message you want to export
                    excWks.Cells(intRow, 1) = olkMsg.Subject
                    excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
                   
                   '********* Mail received time *******
                   
                    TextBody = olkMsg.Body
                    Index = InStr(1, TextBody, "Sent:", vbTextCompare)
                    tmpIndex = InStr(Index, TextBody, ",", vbTextCompare)
                    strSent = Right(TextBody, Len(TextBody) - tmpIndex - 1)
                    subStrSent = Left(strSent, InStr(1, strSent, "To:", vbTextCompare) - 3)
                    
                   '********* End Mail received time *******
                   
                    excWks.Cells(intRow, 3) = subStrSent
                    excWks.Cells(intRow, 4) = GetSMTPAddress(olkMsg, intVersion)
excWks.Cells(intRow, 5) = CalcDiff2Dates(olkMsg.ReceivedTime, subStrSent)
                          
                    intRow = intRow + 1
                End If
            Next
            Set olkMsg = Nothing
            excWkb.SaveAs strFilename
            excWkb.Close
        End If
        Set excWks = Nothing
        Set excWkb = Nothing
        Set excApp = Nothing
        MsgBox "Process complete.  A total of " & intRow - 2 & " messages were exported.", vbInformation + vbOKOnly, "Export messages to Excel"

End Sub
      
         
    Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String

        Dim olkSnd As Outlook.AddressEntry, olkEnt As Object
        'Dim olkPrp As Object
        On Error Resume Next
        Select Case intOutlookVersion
            Case Is < 14
                If Item.SenderEmailType = "EX" Then
                    GetSMTPAddress = SMTP2007(Item)
               Else
                    GetSMTPAddress = Item.SenderEmailAddress
                End If
            Case Else
                Set olkSnd = Item.Sender
                If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
                    Set olkEnt = olkSnd.GetExchangeUser
                    GetSMTPAddress = olkEnt.PrimarySmtpAddress
                Else
                    GetSMTPAddress = Item.SenderEmailAddress
                End If
        End Select
        On Error GoTo 0
        'Set olkPrp = Nothing
        Set olkSnd = Nothing
        Set olkEnt = Nothing
    End Function
     
<name removed="">
Function CalcDiff2Dates(ByVal d1 As Date, _
                        ByVal d2 As Date) As String


  Dim Second As Long, Day As Long, Hour As Long
  Dim CompleteHour As String

 Second = DateDiff("s", d1, d2)

Hour = Second \ 3600

If Hour > 23 Then


Day = Hour \ 24


CompleteHour = Format((d2 - d1), "hh:mm:ss")


  Else 
     Day = 0

CompleteHour = Format((d2 - d1), "hh:mm:ss")


  End If


  If Day = 0 Then 

CalcDiff2Dates = CompleteHour


  Else 

CalcDiff2Dates = Day & " day(s), " & CompleteHour


  End If
    Exit Function


End Function


Thanks in advance!!!</name>
 
Last edited by a moderator:

Some videos you may like

This Week's Hot Topics

Top