Multiple Pivot Table Build Issue

baycolor · March 21st, 2008, 10:15 AM

Hi, I'm using Excel 2003 (SP2).

I've created a macro that runs upon workbook open. The workbook contains approximately 11 tabs. The macro code is below. It basically does the following...

1) Checks for the existence of another workbook (rmdbacctindrevrawdata.xls output from Crystal Reports - has 1 tab).
2) If the rmdbacctindrevrawdata.xls exists open it and repopulate the raw data tab in the workbook with the macro (1 of the 11 tabs).
3) Populate the remaining 10 tabs from the raw data tab.
4) Open a second workbook (workbook the end user will use) and copy the 10 refreshed tabs into the new workbook.
5) On an empty sheet in the user workbook create two pivot tables from one of the 10 tabs.

Everything works fine - even creating the two pivot tables. The problem occurs after I copy the first pivot table to create the second pivot table. When I attempt to set the RowFields in the second pivot table I get the following message:

Run-time error '438': Object doesn't support this property or method.

The code line below that causes this error is just after the line "'**************** NEXT LINE GIVES THE ERROR ****************".

About 10 lines from the bottom. I'm not sure why this is a problem as about 11 lines above this I use the same code to set the RowFields in the first pivot table.

I attempted to change AddFields to UpdateFields or UpdFields but I haven't had any luck. I'm very unfamiliar with the VBA Object Model and I'm surprised I've gotten as far as I have so quickly but I'm pretty stuck on this. Anyone have any suggestions?

Thanks

Code:

Private Sub Workbook_Open()

' Check and see if a Crystal Report Excel output file rmdbacctindrevrawdata.xls exists.
' If a file doesn't exist exit and don't repopulate this workbook.
    Dim sPath As String
    sPath = "C:\Documents and Settings\MS130628\My Documents\Teradata Marketing\Projects\Reports\Duns Revenue\Dougs Files Duns Load\ExcelLoading\Live\rmdbacctindrevrawdata.xls"
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Test if directory or file exists
    If fso.FileExists(sPath) Then
        PopWrkBook
    Else
        Application.DisplayAlerts = False
        Set fso = Nothing
        Application.Quit
    End If

    Sheets("RawData").Cells.ClearContents
    Sheets("RawData").Visible = False
    Application.DisplayAlerts = False
    Set fso = Nothing
    Application.Quit
End Sub

 

 

' Main procedure that is executed to populate this workbook.  Only executed if a
' Crystal Reports Excel output file exists.
Sub PopWrkBook()
    ' Declare and populate an array with all worksheet names that need to be repopulated.
    Dim aIndWrkShtArr(13)

    aIndWrkShtArr(1) = "Finance"
    aIndWrkShtArr(2) = "Comm-Media"
    aIndWrkShtArr(3) = "Gov"
    aIndWrkShtArr(4) = "Healthcare"
    aIndWrkShtArr(5) = "Insurance"
    aIndWrkShtArr(6) = "Mfg"
    aIndWrkShtArr(7) = "Retail"
    aIndWrkShtArr(8) = "Transportation"
    aIndWrkShtArr(9) = "Travel"
    aIndWrkShtArr(10) = "Non-Targeted"
    aIndWrkShtArr(11) = "OtherIndustries"
    aIndWrkShtArr(12) = "Partners+Influencers"
    aIndWrkShtArr(13) = "AllIndustries"

 

    ' Unhide raw data sheet and make sure it's empty.  Open new data workbook from Crystal Reports.
    ' Copy in new workbook data.  Close new workbook.
    Sheets("RawData").Visible = True
    Sheets("RawData").Select
    Cells.ClearContents
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\MS130628\My Documents\Teradata Marketing\Projects\Reports\Duns Revenue\Dougs Files Duns Load\ExcelLoading\Live\rmdbacctindrevrawdata.xls"
    Cells.Copy
    Windows("rmdbacctindrevmacro.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False


    ' This macro was originally in procedure called "Auto_Open".  It was changed to be in a procedure called
    ' "Workbook_Open".  Macro wasn't automatically running via "Auto_Open".  After the change was made the
    ' following line of code stopped working.  Didn't matter that the source data workbook was closed as it
    ' disappears when Excel closes so the line was just commented out.
    ' Windows("rmdbacctindrevrawdata.xls").Close

 

    ' Call a procedure that will delete all data from the worksheets.
    EmptyWorksheets (aIndWrkShtArr)

 

    ' Sort data in raw data sheet by industry - in preparation for populating individual industry sheets.
    Sheets("RawData").Select
    Cells.Sort Key1:=Range("F1"), Order1:=xlAscending, Key2:=Range("A1"), Order2:=xlDescending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

 

    ' Loop through the array of sheets and determine which RMDB industry name
    ' each sheet maps to.  Then call a procedure that will populate each sheet.
    Dim sWrkShtName As String
    For i = 1 To UBound(aIndWrkShtArr)
        Select Case aIndWrkShtArr(i)
            Case "AllIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "AllIndustries"
            Case "Finance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Financial"
            Case "Comm-Media"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Comm & Media/Ent"
            Case "Gov"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Government"
            Case "Healthcare"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Healthcare"
            Case "Insurance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Insurance"
            Case "Mfg"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Manuf"
            Case "Retail"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Retail"
            Case "Transportation"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Transportation"
            Case "Travel"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Travel"
            Case "Non-Targeted"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Non-Target"
            Case "OtherIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Other Industries"
            Case "Partners+Influencers"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Partners+Influencers"
        End Select
    Next i

    ' Call a procedure that will sort format the data in all worksheets.
    FormatWrkSheets (aIndWrkShtArr)

    ' Call a procedure that will create a blank workbook and copy all data sheets in this workbook
    ' into the new workbook.  This new workbook is the workbook users will download without this macro.
    CreateUserWrkBook (aIndWrkShtArr)

    ' Make sure clipboard is empty before ending.
    Application.CutCopyMode = False
    Set fso = Nothing
End Sub

 

 

' Procedure takes in an array of sheet names and removes all data from each sheet. And activate
' cell A1 in each sheet in preperation for pasting in new industry specific data.
Sub EmptyWorksheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        With Sheets(IndWrkShtArr(i))
            .Cells.ClearContents
            Sheets("RawData").Range("1:1").Copy Destination:=.Range("A1")
        End With
    Next i
End Sub

 

 

' Procedure is passed an industry worksheet name and a corresponding RMDB industry name.  The
' procedure determines the start and row of the industry data in the raw worksheet, copies those
' rows into the appropriate industry worksheet.
Sub PopWorkSheets(sWrkShtName As String, sIndName As String)
    Dim iRowStartNo As Integer
    Dim iRowLastNo As Integer

    ' If the All Industries worksheet is being worked copy in all industry data otherwise just
    ' copy in industry specific data.
    If sWrkShtName = "AllIndustries" Then
        Cells.Copy Destination:=Sheets(sWrkShtName).Range("A1")
        Sheets("RawData").Select
    Else
        ' Call functions to determine start and end rows. Then select and copy rows into target
        ' industry worksheeet. Put focus back on cell A1 in raw data worksheet (prep for next
        ' pass through).
        iRowStartNo = IndStartRowNo(sIndName)
        iRowLastNo = IndLastRowNo(sIndName)
        ' If the start or last row values = 1 the functions that looked for start and loast rows
        ' didn't find any data for the industry being processed.  Skip around the copying and pasting
        ' in this situation and leave an empty tab.
        If (iRowStartNo <> 1 And iRowLastNo <> 1) Then
            Range("A" & iRowStartNo, "N" & iRowLastNo).Copy Destination:=Sheets(sWrkShtName).Range("A2")
            Sheets("RawData").Select
            Range("A1").Select
        End If
    End If
End Sub

 

 

' Function returns the row # of the first row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndStartRowNo(sIndustry As String) As Integer
    Columns("F:F").Select
    ' The following find will throw an error if an industry that is being processed is not
    ' found in the RawData tab.  Avoid the error and continue processing.  Any industry that
    ' caused an error will end up with an empty tab of data.
    On Error Resume Next
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndStartRowNo = ActiveCell.Row
End Function

 

 

' Function returns the row # of the last row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndLastRowNo(sIndustry As String) As Integer
    Columns("F:F").Select
    ' The following find will throw an error if an industry that is being processed is not
    ' found in the RawData tab.  Avoid the error and continue processing.  Any industry that
    ' caused an error will end up with an empty tab of data.
    On Error Resume Next
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndLastRowNo = ActiveCell.Row
End Function

 

 

' Procedure takes in an array of worksheet names and sort by revenue, then account name and formats
' each.  Also hide the revenue year, account no, duns no and internal publicity clause columns.
Sub FormatWrkSheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        Sheets(IndWrkShtArr(i)).Select
        If IndWrkShtArr(i) = "AllIndustries" Then
            Cells.Sort Key1:=Range("A1"), Order1:=xlDescending, Key2:=Range("E1"), Order2:=xlAscending, _
                Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            Rows("1:1").Font.Bold = True
            Rows("1:1").EntireRow.AutoFit
            Cells.EntireColumn.AutoFit
            Columns("E:E").ColumnWidth = 34.29
            Columns("I:I").ColumnWidth = 17.29
            Columns("J:J").ColumnWidth = 18.71
            Columns("K:K").ColumnWidth = 10.57
            Columns("B:B").EntireColumn.Hidden = True
            Columns("D:D").EntireColumn.Hidden = True
            Columns("J:J").EntireColumn.Hidden = True
            Columns("L:L").EntireColumn.Hidden = True
            Columns("M:M").EntireColumn.Hidden = True
            ActiveWindow.FreezePanes = True
            Range("A1").Select
        Else
            Rows("1:1").Font.Bold = True
            Rows("1:1").EntireRow.AutoFit
            Cells.EntireColumn.AutoFit
            Columns("E:E").ColumnWidth = 34.29
            Columns("I:I").ColumnWidth = 17.29
            Columns("J:J").ColumnWidth = 18.71
            Columns("K:K").ColumnWidth = 10.57
            Columns("B:B").EntireColumn.Hidden = True
            Columns("D:D").EntireColumn.Hidden = True
            Columns("J:J").EntireColumn.Hidden = True
            Columns("L:L").EntireColumn.Hidden = True
            Columns("M:M").EntireColumn.Hidden = True
            ActiveWindow.FreezePanes = True
            Range("A1").Select
        End If
    Next i
End Sub

 

 

' Procedure takes in an array of worksheets.  Creates a new workbook, Saves the workbook, copies worksheets
' from this workbook into it.  Deletes blank sheets in new workbook. Resaves new workbook after population.
' Note: The new workbook must be saved prior to copying worksheets into it.  And the sheet copying must be
' done the way its done in order to have them ordered correctly in the new workbook.

Sub CreateUserWrkBook(IndWrkShtArr As Variant)
    Dim WkBk As Workbook
    Set WkBk = Workbooks.Add
    Application.DisplayAlerts = False
    WkBk.SaveAs Filename:="C:\Documents and Settings\MS130628\My Documents\Teradata Marketing\Projects\Reports\Duns Revenue\Dougs Files Duns Load\ExcelLoading\Live\rmdbacctindrev.xls"

    For i = UBound(IndWrkShtArr) To 1 Step -1
            If (IndWrkShtArr(i)) <> "AllIndustries" Then
                Sheets(IndWrkShtArr(i)).Copy Before:=Workbooks("rmdbacctindrev.xls").Sheets(1)
            End If
    Next i
    Sheets("AllIndustries").Copy Before:=Workbooks("rmdbacctindrev.xls").Sheets("Finance")

    Workbooks("rmdbacctindrev.xls").Sheets("Sheet2").Delete
    Workbooks("rmdbacctindrev.xls").Sheets("Sheet3").Delete
    Workbooks("rmdbacctindrev.xls").Sheets("Sheet1").Move Before:=Workbooks("rmdbacctindrev.xls").Sheets(1)
    Workbooks("rmdbacctindrev.xls").Sheets("Sheet1").Name = "PivotSummary"
    Workbooks("rmdbacctindrev.xls").Activate
    ActiveWindow.TabRatio = 0.9

' *************** BUILD PIVOT CODE *****************
    Workbooks("rmdbacctindrev.xls").Activate
    Dim iLastRow As Integer
    Dim iFirstRow As Integer
    Worksheets("AllIndustries").Activate
    ActiveCell.SpecialCells(xlLastCell).Select
    iLastRow = ActiveCell.Row
    iFirstRow = 1
    MsgBox (iLastRow & iFirstRow)
    Workbooks("rmdbacctindrev.xls").Activate
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Activate
    Workbooks("rmdbacctindrev.xls").PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "AllIndustries!R1C1:R" & iLastRow & "C14").CreatePivotTable TableDestination:="", _
        TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10
    Workbooks("rmdbacctindrev.xls").PivotTableWizard _
    TableDestination:=Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Cells(3, 1)
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Range("A3").Select

'**************** LINE ALSO USED HERE ****************  

    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").PivotTables("PivotTable1").AddFields RowFields:=Array( _
        "Official Customer", "Industry"), ColumnFields:="Tier"
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").PivotTables("PivotTable1").PivotFields("Account").Orientation = _
        xlDataField
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Application.CommandBars("PivotTable").Visible = False
    ActiveWorkbook.ShowPivotTableFieldList = False
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Range("A2:G31").Select
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Range("G31").Activate
    Selection.Copy
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Range("I2").Select
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Paste
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Range("L7").Select
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary").Application.CutCopyMode = False

'**************** NEXT LINE GIVES THE ERROR ****************       
    Workbooks("rmdbacctindrev.xls").Worksheets("PivotSummary"). _
        ActiveSheet.PivotTables("PivotTable2").AddFields RowFields:=Array( _
            "Official Customer", "Region"), ColumnFields:="Tier"

'    ActiveSheet.PivotTables("PivotTable2").AddFields RowFields:=Array( _
'        "Official Customer", "Region"), ColumnFields:="Tier"

    ActiveWorkbook.ShowPivotTableFieldList = True
    Application.CommandBars("PivotTable").Visible = False
    ActiveWorkbook.ShowPivotTableFieldList = False

    Workbooks("rmdbacctindrevmacro.xls").Activate
    WkBk.SaveAs Filename:="C:\Documents and Settings\MS130628\My Documents\Teradata Marketing\Projects\Reports\Duns Revenue\Dougs Files Duns Load\ExcelLoading\Live\rmdbacctindrev.xls"

End Sub