VBA create pivot with "data is added to the Data Model"

Question

I have the following code below. The PivotTable is created just fine, but it does not have the "data is added to the data model" option selected. This means that I cannot use the "distinct count" option in the values field. How do I achieve this?

Sub test()

testpath = "C:\UserData\testfolder\testfile.xlsx"

With Workbooks.Open(testpath)
    Dim ws As Worksheet
    Set ws = .Worksheets(2)
    ws.Activate
    Dim newSheet As Worksheet
    Set newSheet = .Worksheets.Add(Before:=ws)
    newSheet.Name = "PivotTableSheet"
    Dim pivotCache As pivotCache
    Set pivotCache = .PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws.UsedRange, Version:=xlPivotTableVersion15)
    Dim pivotTable As pivotTable
    Set pivotTable = pivotCache.CreatePivotTable(TableDestination:=newSheet.Cells(1, 1), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion15)
End With

End Sub

Answer 1

You need to add the range to the connections.

Option Explicit

Sub Test()

    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim NewSheet As Worksheet
    Dim PivotCache As PivotCache
    Dim PivotTable As PivotTable
    Dim Conn As WorkbookConnection
    Dim Rng As Range
    Dim ConnName As String
    Dim TestPath As String
    TestPath = "C:\UserData\testfolder\testfile.xlsx"
    Rem TestPath = "D:\vba\sample data\SampleData.xlsx"
    Rem Open the workbook
    Set Wb = Workbooks.Open(TestPath)
    Set Ws = Wb.Worksheets(2)
    
    Rem Define the data range, assuming the data has headers
    Set Rng = Ws.UsedRange
    
    Rem Create a new sheet for the PivotTable
    Set NewSheet = Wb.Worksheets.Add(Before:=Ws)
    NewSheet.Name = "PivotTableSheet"
    
    Rem Add the UsedRange to the Data Model by creating a WorkbookConnection
    ConnName = "DataModelConnection"
    On Error Resume Next ' Ignore if connection already exists
    Set Conn = Wb.Connections(ConnName)
    On Error GoTo 0
    
    If Conn Is Nothing Then
        Set Conn = Wb.Connections.Add2(Name:=ConnName, _
                                       Description:="Connection to worksheet data", _
                                       ConnectionString:="WORKSHEET;" & Wb.FullName, _
                                       CommandText:=Rng.Address(External:=True), _
                                       lCmdtype:=xlCmdExcel)
    End If
    
    Rem Now create a PivotCache from the Data Model (external connection)
    Set PivotCache = Wb.PivotCaches.Create(SourceType:=xlExternal, SourceData:=Conn, Version:=xlPivotTableVersion15)
    
    Rem Create the PivotTable from the data model connection
    Set PivotTable = PivotCache.CreatePivotTable( _
        TableDestination:=NewSheet.Cells(1, 1), _
        TableName:="PivotTable1", _
        DefaultVersion:=xlPivotTableVersion15)
    
    Rem Cleanup
    Set Wb = Nothing
    Set Ws = Nothing
    Set Rng = Nothing
    Set NewSheet = Nothing
    Set PivotCache = Nothing
    Set PivotTable = Nothing
    
End Sub

Alternatively you could manually add the range.

1. Select the data range

   • Highlight the range of data you want to add, including the headers.

2. Go to the Data tab

   • Click on the Data tab in the Excel ribbon.

3. Click on "From Table/Range"

   • In the "Get & Transform Data" group, click From Table/Range.

4. Confirm the range

   • In the Create Table dialog box, confirm that your range is correct and check the box for "My table has headers" if applicable.

5. Load to Data Model

   • The Power Query Editor will open. Without making changes, click Close & Load from the top-left corner, then select Close & Load To....
   • In the Import Data dialog, choose "Only Create Connection" and check the box labeled "Add this data to the Data Model."

6. Click OK

   • The range is now added to the Data Model for use in PivotTables or Power Pivot.