Creating Pivots in Excel VBA and Create an Email

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.

Hi - can someone please help me in this.

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

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.

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

---

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

---

Are you sure your sheet name is correct? ie, ccm_dispute_results

Yes. I used a new sheet and the Test sheet attached as well.

Attached where?

The original Test file that i had attached.

The code probably errors out because the name of the sheet used in the code is not found in the workbook you are trying to run the code from. Where have you pasted the code? Is it in the personal file? If yes, then in the code above, instead of ThisWorkbook, use ActiveWorkbook

Here's the file I worked on

It worked in the Test file that i had attached. But when i use the code in my main personal file, it throws the error "Method 'CreatePivotTable' of object 'PivotCache' Failed.

I am attaching my main personal file and the complete code after which i want to use the pivot code.

Files Attached

Hi - sorry to bother. Did you get a chance to look into this. when i post on a blank module, the code works correct. but when i post it as a part of my complete macro, it throws the error.

Looking at this now.

i guess i have found the reason. my file is an export from a web link. once i save it to any filepath and then run the code, it works perfect.


If i have to add more pivots and more criteria, how do i play with the code as i am unable to understand the code that much.

Glad you got it to work. The code first adds a pivot cache, and then out of the pivot cache, it runs 3 loops and creates the three pivot tables. And since you were keeping everything constant except the column fields, I used an array, with those 3 names, and in the loop, just built each pivot in the same way, and just positioning it 2 rows below the last filled row. Just execute the code line by line, and you'll figure it out.

Thanks for your help.

Hi...In the pivot, for e.g. in the third pivot, i dont have a comment "Move Amount Mismatch", and everything is "OK" in the data, is it possible for the pivot not to appear?

Just before the end of each iteration, add these green line

Code:

---

        If pvt.DataBodyRange.Rows.Count < 2 Then
            pvt.TableRange1.EntireRow.Delete
        End If
    Next lngPivots

---

Hi - This is not happening. for e.g. in the Move Summary Pivot, if i have all "OK" and nothing as "Move Amount Mismatch", then the pivot shows with OK in the 'xlRowField' Field.

is it possible to keep just what i require in the pivot like "Move Amount Mismatch" rather than other items as False.?

Code:

---

.PivotItems("OK").Visible = False
        .PivotItems("(blank)").Visible = False

---

I tried doing

Code:

---

.PivotItems("Move Amount Mismatch").Visible = True

---

but this doesnt work..

Hi - Sorry to bother. But this is not working. can you please help.

With your above code, the pivot does not get deleted. This is where i put it

Code:

---

For lngPivots = 1 To 3
        With ActiveWorkbook
            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("MOVE SUMMARY", "COMMENT SUMMARY", "CALL 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 = "PivotStyleMedium8"
        End With
    Next lngPivots
    Application.ScreenUpdating = 1
    If pvt.DataBodyRange.Rows.Count < 2 Then
            pvt.TableRange1.EntireRow.Delete
        End If

---

i guess i know the reason why...ur code says if the pivot has less than 2 rows then delete pivot....
E.g. in the Move Summary Pivot, if i have all "OK" and nothing as "Move Amount Mismatch", then the pivot throws up all 'OK' in the Rowfield.

this makes the pivot more than two rows.

can we do something here.