VBA - Invalid Procedure when Creating Pivot Tables within a Loop

Question

All,

I call this subfunction within a loop in another subfunction. The loop works well without this sub called. When I call this sub, it works fine once, and then, on the second go, I get a "runtime error 5 - invalid procedure call or argument" here.

I have many sheets, each with a table. I want to summarize each table with a pivot table.

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
    TableDestination:=dest, TableName:=pivnm, _
    DefaultVersion:=xlPivotTableVersion10

You can see the whole subfunction below.

Sub PIVOT()
Dim pivnm, shtnm, tblnm, dest As String
Application.EnableEvents = False

shtnm = ActiveSheet.Name
tblnm = Range("N2").Value 'I have previously sent the table name to this cell
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_") 
'The tables are named with underscores, but were stored with spaces

Range("N3") = pivnm
With Range("N3") 'simply wraps the text in the cell
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

dest = shtnm & "!R1C15" 'sets the destination

    Sheets(shtnm).Select
    Range("C1").Select 
    'the following was written using the macro recorder, with names replaced by
    'variables
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:=dest, TableName:=pivnm, _
        DefaultVersion:=xlPivotTableVersion10
    Sheets(shtnm).Select
    Cells(1, 15).Select
    With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
        pivnm).PivotFields("Process text"), "Count of Process text", xlCount
    ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
        pivnm).PivotFields("Column1"), "Sum of Column1", xlSum
    With ActiveSheet.PivotTables(pivnm).DataPivotField
        .Orientation = xlColumnField
        .Position = 1
    End With

    With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
        .Orientation = xlRowField
        .Position = 1
    End With

shtnm = vbNullString 'I tried resetting everything. Didn't work
tblnm = vbNullString
pivnm = vbNullString
dest = vbNullString

End Sub

Please let me know if I have left any information out or if there is anything I can do better!

I was asked to attach the loop from the other function - so here it is...It probably looks ridiculous to anyone but me...

While count3 <= count2
    DoEvents
    Application.StatusBar = "Updating. Sheet " & (count3) & " of 61 complete."
    Sheets("Sheet2").Select
    Selection.AutoFilter Field:=2
    Selection.AutoFilter Field:=2, Criteria1:=Range("O" & CStr(count3)).Value
    Range("A1:M" & CStr(count)).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.count)
    ActiveSheet.Paste
    If Range("B2") <> "" Then

        ActiveSheet.Name = Range("B2")
        tblnm = Range("B2").Value
        Sheets(tblnm).Select

        Application.StatusBar = "Making Table" & (count3) & " of 61 complete."

        While Range("B" & CStr(count4 + 1)) <> ""
            count4 = count4 + 1
        Wend

        Range("N1").Value = count4

        DataArea = ("$A$1:$M$" & count4)
        DataArea1 = DataArea

        ActiveWorkbook.ActiveSheet.ListObjects.Add(xlSrcRange, Range(DataArea1), , xlYes).Name = _
            tblnm
        ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:= _
            "=*UF_*", Operator:=xlAnd, Criteria2:="<>*Drive*"
        ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=8, Criteria1:= _
            "<>#VALUE!", Operator:=xlAnd
        ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort.SortFields.Add Key _
            :=Range("M1:M" & CStr(count4)), SortOn:=xlSortOnValues, Order:=xlDescending, _
            DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With

        Call RhidRow

        Columns("A:A").EntireColumn.Hidden = True
        Columns("B:B").EntireColumn.Hidden = True
        Columns("F:F").EntireColumn.Hidden = True
        Columns("G:G").EntireColumn.Hidden = True
        Columns("H:H").EntireColumn.Hidden = True
        Columns("I:I").EntireColumn.Hidden = True
        Columns("J:J").EntireColumn.Hidden = True
        Columns("K:K").EntireColumn.Hidden = True
        Columns("L:L").EntireColumn.Hidden = True
        Columns("C:C").EntireColumn.AutoFit
        Columns("D:D").EntireColumn.AutoFit
        Columns("E:E").EntireColumn.AutoFit
        Columns("M:M").EntireColumn.AutoFit

        While Range("M" & CStr(count5 + 1)) <> ""
            count5 = count5 + 1
        Wend

        Range("N2") = tblnm
        With Range("N2")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Call PIVOT
    Else
        ActiveSheet.Delete
    End If
    Range("A1").Select
    count3 = count3 + 1
    count4 = 2
    count6 = 2
Wend

I can't see a loop, or anywhere that the relevant values would change, so you may be trying to put a pivot table over the top of an existing one. — Rory
– Rory, Commented Jun 17, 2014 at 14:20
It looks from the VBA help that TableDestination should be a Range object not a string. So try replacing TableDestination:=dest with TableDestination:=Range(dest)? — aucuparia
– aucuparia, Commented Jun 17, 2014 at 14:21
Making it a range causes it to not work at all. It is not the correct syntax since it uses RC format instead. — Tanner
– Tanner, Commented Jun 17, 2014 at 14:25
It lost my formatting when I copied it in. Let me know if it's too hard to read and if there is something I can do to fix it, please. — Tanner
– Tanner, Commented Jun 17, 2014 at 14:29
Do your sheet names have spaces in them? If so, you need: dest = "'" & shtnm & "'!R1C15" — Rory
– Rory, Commented Jun 17, 2014 at 14:35

Rory · Accepted Answer · 2014-06-17 15:09:34Z

If your sheet names have spaces in them, you need:

dest = "'" & shtnm & "'!R1C15"

This is untested, but as an idea as to passing parameters:

Sub PIVOT(tblnm As String, ws As Worksheet)
    Dim pivnm                       As String
    Dim shtnm                       As String
    Dim dest                        As String
    Dim PT                          As PivotTable
    Application.EnableEvents = False

    With ws
        shtnm = "'" & .Name & "'"
        pivnm = tblnm & " PIVOT"
        tblnm = Replace(tblnm, " ", "_")
        'The tables are named with underscores, but were stored with spaces


        With .Range("N3")
            .Value = pivnm
            'simply wraps the text in the cell
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    End With

    dest = shtnm & "!R1C15"    'sets the destination

    'the following was written using the macro recorder, with names replaced by
    'variables
    Set PT = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                                               tblnm, Version:=xlPivotTableVersion10).CreatePivotTable( _
                                               TableDestination:=dest, TableName:=pivnm, _
                                               DefaultVersion:=xlPivotTableVersion10)

    With PT
        With .PivotFields("Process text")
            .Orientation = xlRowField
            .Position = 1
        End With
        .AddDataField .PivotFields("Process text"), "Count of Process text", xlCount
        .AddDataField .PivotFields("Column1"), "Sum of Column1", xlSum
        With .DataPivotField
            .Orientation = xlColumnField
            .Position = 1
        End With

        With .PivotFields("Process text")
            .Orientation = xlRowField
            .Position = 1
        End With
    End With

End Sub

and the calling code would use something like:

Call PIVOT(tblnm, wks)

where wks is a Worksheet variable set to whichever sheet has the data.

Collectives™ on Stack Overflow

VBA - Invalid Procedure when Creating Pivot Tables within a Loop

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related