VBA Excel ERROR creating a second pivot table from the same database

0
votes

I'm not a rookie but not yet a pro on VBA Excel and I have encounter myself with a problem I have being struggling for a while.

Tried on google and this forum to read some data for a guide or the answer without success so I'll explain it to you hoping someone can give me a hint or enlightenment.

I want to code a VBA Macro that creates a Sheet from my Database called "ClientProperties" in which I'll create a Pivot Table "PT2" containing all the client names on a filtered state/Country and some properties like promotions name applied for that client, and the promotion value sorted by month. Then It will create a new sheet with the name of every state/Country on my Database but in each sheet I have to create one Pivot Table for each client ("PT1", "PT2", ... "PTn") showing the product categories that client has and sales sorted by month; Below that Pivot table I have to paste the properties from the "PT2" for that client.

I can create the "PT2", apply the filters and sort the information as needed without any problems but when I try to create the "PT1" it shows the error:

"Error '5' has occurred at runtime:
Invalid argument or procedure call".

The fist Pivot is actually created like this:

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ClientProperties"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R50C100"_
Version:=6).CreatePivotTable TableDestination:="ClientProperties!R3C1", TableName:="DT1", DefaultVersion:=6

The second (The one with error) like this (Note: PL(X) is an array of strings [state/Country name]):

For X = 0 To UBound(PL, 1)
  Sheets.Add After:=ActiveSheet
  ActiveSheet.Name = "" & PL(x) & ""
  ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R50C100"_
  Version:=6).CreatePivotTable TableDestination:="" & PL(X) & "R8C23", TableName:="DT2", DefaultVersion:=6

Here is my code resumed:

Global LBD As Long, ABD As Integer, LBB As Long, ABB As Integer, PL(11) As String, CA() As String, AN As String, CTE As Boolean, TR As String * 1, FBB As Integer
Global ASS() As String, CAP() As String, FTD As Integer, ITD As Boolean, LTD As Integer, PN As String * 1, CRK As Integer, CANCEL As Boolean

Sub Main()

    Call Variables
    Worksheets("Base").Visible = True
    Worksheets("Base").Select
    LBD = Rows(1, 1)
    ABD = Columns(1, 1)
    Call AditionalProcess
    Call ClientProps
    Call SummaryTabs
    Worksheets("Base").Visible = False
    Worksheets("ClientProperties").Visible = False

End Sub

The Other modules are:

Sub Variables()

    If TR = "M" Then
        CTE = True
        ReDim CA(3) As String
        CA(0) = "Club"
        CA(1) = "Conv"
        CA(2) = "Reg"
        CA(3) = "Ret"
    Else
        CTE = False
        ReDim CA(3) As String
        CA(0) = "Whs"
        CA(1) = "C3"
        CA(2) = "C5"
        CA(3) = "Dist"
    End If
    PL(0) = "CALIFORNIA"
    PL(1) = "FLORIDA"
    If TR = "M" Then PL(2) = "AUSTIN" Else PL(2) = "HOUSTON"
    PL(3) = "HAWAI"
    PL(4) = "NEW JERSEY"
    PL(5) = "ARIZONA"
    PL(6) = "PENSILVANIA"
    PL(7) = "VIRGINIA"
    PL(8) = "MICHIGAN"
    PL(9) = "GEORGIA"
    PL(10) = "COLORADO"
    PL(11) = "OHIO"

End Sub

Function Rows(X As Long, Y As Integer) As Long
    Do While Cells(X, Y) <> Empty
        X = X + 1
    Loop
        Rows = X - 1
End Function
Function Columns(X As Long, Y As Integer) As Long
    Do While Cells(X, Y) <> Empty
        Y = Y + 1
    Loop
        Columns = Y - 1
End Function

Sub AditionalProcess()

    Worksheets("Base").Select
    Range(Cells(2, 8), Cells(LBD, 8)).Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    ReDim CAP(20) As String
    For Y = 1 To 20
        CAP(Y - 1) = Range(Cells(Y, 1), Cells(Y, 1))
    Next Y
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

End Sub

Sub ClientProps()

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "ClientProperties"
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R" & LBD & "C" & ABD & "", Version:=6).CreatePivotTable TableDestination:="ClientProperties!R3C1", TableName:="PT2", DefaultVersion:=6
    Sheets("BB´s").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PT2")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
        .PageFieldOrder = xlDownThenOver
    End With
    With ActiveSheet.PivotTables("PT2").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PT2").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PT2").PivotFields("FY")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PT2").PivotFields("Client")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PT2")
        .ColumnGrand = False
        .RowGrand = False
    End With
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M01"), " M01", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M02"), " M02", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M03"), " M03", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M04"), " M04", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M05"), " M05", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M06"), " M06", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M07"), " M07", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M08"), " M08", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M09"), " M09", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M10"), " M10", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M11"), " M11", xlSum
    ActiveSheet.PivotTables("PT2").AddDataField ActiveSheet.PivotTables("PT2").PivotFields("M12"), " M12", xlSum
    With ActiveSheet.PivotTables("PT2").PivotFields("PROMOS")
        .Orientation = xlRowField
        .Position = 1
    End With

    LBB = Rows(8, 1)
    ABB = Columns(7, 1)
    Range(Cells(8, 2), Cells(LBB, ABB)).Style = "Comma"
    Range(Cells(8, 2), Cells(LBB, ABB)).NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
    ActiveSheet.PivotTables("PT2").PivotFields("PROMOS").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveWorkbook.ShowPivotTableFieldList = False

End Sub

Sub SummaryTabs()

    For X = 0 To UBound(PL, 1)

        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = "" & PL(X) & ""        
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R" & LBD & "C" & ABD & "", Version:=6).CreatePivotTable TableDestination:="" & PL(X) & "!R8C23", TableName:="PT1." & (X+2), DefaultVersion:=6
End Sub

At this point is where the error message appears and that's why i cut the code...

2
excelvba
does the loop work fine for just adding sheets (without pivot creation)? e.g. if you debug.print sheet's name - Stachu
Yes, I've tried it out by itself and worked just fine. - AlexT

2 Answers

0
votes

Two things:

  1. you are missing '!' before the range in loop (!R8C23 instead of R8C23)
  2. PivotTable name is the same in the loop, that will not work

Also you can use the same PivotCache for all the pivots, as it's always the same, like here (this code has both issues fixed):

Dim ws As Worksheet
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = "ClientProperties"
Dim pc as PivotCache
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Base!R1C1:R50C100", _ 
Version:=6)
pc.CreatePivotTable TableDestination:="ClientProperties!R3C1", TableName:="DT1", DefaultVersion:=6

For X = 0 To UBound(PL, 1)
  Set ws = Sheets.Add(After:=ActiveSheet)
  ws.Name = "" & PL(x) & ""
  pc.CreatePivotTable TableDestination:="" & PL(X) & "!R8C23", TableName:="DT" & (X+2), DefaultVersion:=6
0
votes

I Just found the answer:

The sheet name in:

TableDestination:="" & PL(X) & "!R8C23"

needs to be surrounded with single quotes in order for it to work:

TableDestination:="'" & PL(X) & "'!R8C23"

Thank you all for your support!!!