Creating Pivot Table with Distinct Count using VBA

Question

I am trying to create a pivot table using Excel 2013 VBA with DISTINCT COUNT as a value field.

I understand that if you create the pivot table manually, you have to

Answer 1

To get a PivotField.Function = xlDistinctCount, the PivotTable (read: its PivotCache) has to be OLAP-based. Your general approach, where the PivotCache.SourceData points to a Range, doesn't work in this case.

To get it OLAP-based, you can add a WorkbookConnection to that range first, and then use the connection for the pivotcache.

I hope this general approach explains it:

Private Sub GenerateNewOLAPbasedPivotTable()
    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

    ' address worksheets
    Set objSheetWithData = ActiveWorkbook.Sheets(1)
    Set objSheetWithPivot = ActiveWorkbook.Sheets(2)

    ' 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

    ' example: reference a cubefield by its name
    ' define a rowfield
    With objPivotTable.CubeFields( _
            "[" & objListObjectWithData.Name & "]." & _
            "[" & objListObjectWithData.ListColumns(1).Name & "]")
        .Orientation = xlRowField
        .Caption = "My CubeField 1"
    End With
    objPivotTable.RowFields(1).Caption = "My RowField 1"

    ' example: reference a cubefield by its index
    ' define a columnfield
    With objPivotTable.CubeFields(2)
        .Orientation = xlColumnField
        .Caption = "My CubeField 2"
    End With
    objPivotTable.ColumnFields(1).Caption = "My ColumnField 1"

    ' define a new measure and use it as datafield
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
        AttributeHierarchy:=objPivotTable.CubeFields(1), _
        Function:=xlDistinctCount, _
        Caption:="My Cube Measure 1")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(1).Caption = "My DataField 1"

End Sub

Answer 2

Use Excel.XlConsolidationFunction if not able to get directly like Excel.XlConsolidationFunction.xlDistinctCount

Answer 3

I just recorded creating a pivot table that uses the option "Add this data to the Data Model". And created a Distinct count field. I had to add the count first, then change it to Distinct. I modified it for your worksheet and pivot table names. Add the measure count of appno, then modify to Distinct. Here is the distinct count section.

With Worksheets("PivotTable").PivotTables("SalesPivotTable").PivotFields( _
    "[Measures].[Count of AppNo]")
    .Caption = "Distinct Count of AppNo"
    .Function = xlDistinctCount
End With