Creating Pivots in Excel VBA and Create an Email

[aaron.mendes]

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]

Hi - can someone please help me in this.

[Excel Fox]

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

[aaron.mendes]

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]

try this

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)).Nam e = "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]

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


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

[Excel Fox]

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

[aaron.mendes]

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

[Excel Fox]

Attached where?

[aaron.mendes]

The original Test file that i had attached.

[Excel Fox]

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

[Excel Fox]

Here's the file I worked on

[aaron.mendes]

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.

[aaron.mendes]

Files Attached

[aaron.mendes]

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.

[Excel Fox]

Looking at this now.

[aaron.mendes]

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.

[Excel Fox]

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.

[aaron.mendes]

Thanks for your help.

[aaron.mendes]

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?

[Excel Fox]

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



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

[aaron.mendes]

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.?

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

[aaron.mendes]

I tried doing

.PivotItems("Move Amount Mismatch").Visible = True
but this doesnt work..

[aaron.mendes]

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


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

[aaron.mendes]

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.