Creating Pivots in Excel VBA and Create an Email

**aaron.mendes** · 07-09-2013, 12:16 AM

Hi,

Attached is my excel data and I need to create multiple pivots on one sheet. I have Created the pivots that i require as my desired output alongwith a recorded macro.
Can you please help me with the code or rectify the recorded code that would create a pivot for different data and ranges.

**aaron.mendes** · 07-09-2013, 02:31 PM

Hi - can someone please help me in this.

**Excel Fox** · 07-09-2013, 08:10 PM

Aaron, can you explain the logic for each of the pivot tables? Will have a look at it.

**aaron.mendes** · 07-09-2013, 08:15 PM

For 1st Pivot, in the Row Labels, I require Call Summary (T) and Counterparty Name (E) and in Value, a count of Agreement (F)
From the dropdown of Call Summary, "OK" and Blanks should be excluded.

Other pivots have the same logic except that the column changes.

Thanks for looking into this.

**Excel Fox** · 07-09-2013, 09:28 PM

try this

Code:

    
    Dim pvc As PivotCache
    Dim pvt As PivotTable
    Dim lng As Long
    Dim lngPivots As Long
    
    Application.ScreenUpdating = 0
    With ThisWorkbook
        Application.DisplayAlerts = 0
        On Error Resume Next
        .Worksheets("Output").Delete
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        Application.DisplayAlerts = 1
        .Worksheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Output"
        Set pvc = .PivotCaches.Create(SourceType:=xlDatabase, SourceData:=.Worksheets("ccm_dispute_results").Cells(1).CurrentRegion.Address(, , xlR1C1, True), Version:=xlPivotTableVersion12)
    End With
    
    For lngPivots = 1 To 3
        With ThisWorkbook
            lng = .Worksheets("Output").Cells(Rows.Count, 1).End(xlUp).Row + 2
            Set pvt = pvc.CreatePivotTable(TableDestination:="Output!R" & lng & "C1", TableName:="PvtCustom" & lng, DefaultVersion:=xlPivotTableVersion12)
        End With
        pvt.AddDataField pvt.PivotFields("Agreement"), "Count of Agreement", xlCount
        With pvt.PivotFields(Array("CALL SUMMARY", "COMMENT SUMMARY", "MOVE SUMMARY")(lngPivots - 1))
            .Orientation = xlRowField
            .Position = 1
            On Error Resume Next
            .PivotItems("OK").Visible = False
            .PivotItems("(blank)").Visible = False
            Err.Clear: On Error GoTo 0: On Error GoTo -1
            .Subtotals(1) = False
        End With
        With pvt.PivotFields("Counterparty Name")
            .Orientation = xlRowField
            .Position = 2
            .Subtotals(1) = False
        End With
        With pvt
            .InGridDropZones = True
            .RowAxisLayout xlTabularRow
            .TableStyle2 = "PivotStyleMedium9"
        End With
    Next lngPivots
    Application.ScreenUpdating = 1
    
End Sub

**aaron.mendes** · 07-09-2013, 09:38 PM

I'm getting an error at tis Code sayin, SubsCript out of Range

Code:

Set pvc = .PivotCaches.Create(SourceType:=xlDatabase, SourceData:=.Worksheets("ccm_dispute_results").Cells(1).CurrentRegion.Address(, , xlR1C1, True), Version:=xlPivotTableVersion12)
    End With