VBA/Macro: Adding Pivot table with connection string

[Jette3173]

Manually I would click the check box to “Add this data to the Data Model”. I am new to VBA and am writing multiple sections to make manipulating these reports daily easier. I have copied and written code from multiple web pages and using the record macros while learning so it may be a bit of a mix!

I have been able to get everything to work except adding the connection so I can summarize by distinct count.

My main concern with this is that my file name and range will change daily as well.

I would appreciate any assistance!

Sub InsertPivotTable()
'
'
'

    
'Declare Variables
    Dim PSheet As Worksheet
    Dim DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long

'Insert a New Blank Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Summary").Delete
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "Summary"
    Application.DisplayAlerts = True
    Set PSheet = Worksheets("Summary")
    Set DSheet = Worksheets("Detail")

'Define Data Range
    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

'Add WB Connection
    MainWB.Connections.Add2 ("WorksheetConnection_ ActiveWorkbook, "", _
    "WORKSHEET;C:\Users\217216X721431\Documents\Test Reports\[Compliance Completion report as of 10.25.xlsm]Detail _
    , "Detail!$A$1:$X$11446", 7, True, False

'Define Pivot Cache
    Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
    TableName:="Pivot Table")

'Insert Blank Pivot Table
    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TableName:="Pivot Table")

'Insert Row Fields
    With ActiveSheet.PivotTables("Pivot Table").PivotFields("HRBP")
    .Orientation = xlRowField
    .Position = 1
    End With
    With ActiveSheet.PivotTables("Pivot Table").PivotFields("1st level structure Description")
    .Orientation = xlRowField
    .Position = 2
    End With

'Insert Column Fields
    With ActiveSheet.PivotTables("Pivot Table").PivotFields("All CUR Complete")
    .Orientation = xlColumnField
    .Position = 1
    End With
    
'Insert Data Field
    With ActiveSheet.PivotTables("Pivot Table").PivotFields("User")
    .Orientation = xlDataField
    .Function = xlSum
    .NumberFormat = "#,##0"
    .Name = "Revenue "
    End With
    
    Sheets("Summary").PivotTables("Pivot Table").PivotFields("[Measures].[Sum of User]"). _
        Function = xlDistinctCount
'Format Pivot Table
    ActiveSheet.PivotTables("Pivot Table").ShowTableStyleRowStripes = True
    ActiveSheet.PivotTables("Pivot Table").TableStyle2 = "PivotStyleMedium9"
    
    
    End Sub

 

[Jette3173]

Took a lot of work and mixing different codes from different sites but I've got it working
In case anyone else comes across needing this!

Sub SetupSummary()
'
'
'
      
'Declare Variables
    Dim objSheetWithData As Worksheet
    Dim objSheetWithPivot As Worksheet
    Dim objListObjectWithData As ListObject
    Dim objConnection As WorkbookConnection
    Dim objPivotCache As PivotCache
    Dim objPivotTable As PivotTable
    Dim objCubeField As CubeField
    Dim objPivotField As PivotField

'Insert a New Blank Worksheet
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "Summary"

' address worksheets
    Set objSheetWithData = Worksheets("Detail")
    Set objSheetWithPivot = Worksheets("Summary")

' address (existing) listobject with data
    If objSheetWithData.ListObjects.Count > 0 Then
        Set objListObjectWithData = objSheetWithData.ListObjects(1)
    Else
        Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
            SourceType:=xlSrcRange, _
            Source:=objSheetWithData.Range("A1").CurrentRegion, _
            XlListObjectHasHeaders:=xlYes)
    End If

' delete existing internal connections if necessary
    For Each objConnection In ActiveWorkbook.Connections
        If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
    Next objConnection

' add new connection to above listobject
    Set objConnection = ActiveWorkbook.Connections.Add2( _
        Name:="My Connection", _
        Description:="My Connection Description", _
        ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
        CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
        lCmdtype:=XlCmdType.xlCmdExcel, _
        CreateModelConnection:=True, _
        ImportRelationships:=False)

' create and configure new pivotcache
    Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
        SourceType:=xlExternal, _
        SourceData:=objConnection)
    With objPivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsNone
    End With

' delete existing pivottable if necessary
    For Each objPivotTable In objSheetWithPivot.PivotTables
        objPivotTable.TableRange2.Clear
    Next objPivotTable

' create and configure new pivottable
    Set objPivotTable = objPivotCache.CreatePivotTable( _
        TableDestination:=objSheetWithPivot.Range("A1"))
    With objPivotTable
        .ColumnGrand = True
        .HasAutoFormat = True
        ' etc.
    End With

'Renaming Pivot Table
    Set objPivotTable = ActiveCell.PivotTable
        With Range("A3").PivotTable
            .Name = "Pivot Table"
        End With

'Insert Row Fields
    With objPivotTable.CubeFields( _
            "[" & objListObjectWithData.Name & "]." & _
            "[" & objListObjectWithData.ListColumns(9).Name & "]")
        .Orientation = xlRowField
        .Caption = "HRBP"
    End With
    objPivotTable.RowFields(1).Caption = "HRBP"
    
    
    With objPivotTable.CubeFields( _
            "[" & objListObjectWithData.Name & "]." & _
            "[" & objListObjectWithData.ListColumns(11).Name & "]")
        .Orientation = xlRowField
        .Caption = "1st level structure Description"
    End With
    objPivotTable.RowFields(1).Caption = "1st level structure Description"
    

'Insert Column Fields
     With objPivotTable.CubeFields(24)
        .Orientation = xlColumnField
        .Caption = "All CUR Complete"
    End With
    objPivotTable.ColumnFields(1).Caption = "All CUR Complete"
    
'Insert Data Field
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
        AttributeHierarchy:=objPivotTable.CubeFields(1), _
        Function:=xlDistinctCount, _
        Caption:="User")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(1).Caption = "User"
    
    
    End Sub