CF in Pivot Table

[paradise]

Hi,

I am looking for a code for conditional formatting in Pivot table.The workbook has 3 sheets .The PT-1 worksheet is Pivot table and I want to highlight the row as stated in dummy data.Sample highlighted row is given for the kind reference as my expected result.The condition that was highlighted on the condition that ,if K column of SO sheet contains "Not Approved" then in Pivot Table it will highlight the row which has been done manually currently.

The link to excel workbook is >>https://1drv.ms/x/s!AlMkmnpeQjaSy2eP4cID5Gj0Z-rh

If anyone require any further info,then kindly let me know.

I have posted in few other forums e.g http://www.excelforum.com/showthread.php?t=1151084&p=4454934&highlight=#post4454934 but still could not received reply till now.Hope in this forum I could get help.

[paradise]

Hi,

I am still eagerly waiting for the response to my query.

[mancubus]

you can post your workbook here.
perhaps one of forum members may help you

[paradise]

Pls find enclosed in attachment.

[Paul_Hossler]

I don't like to use conditional formatting for things like that, so I tie into the Update event





Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim rRow As Range
Dim rSO As Range
Dim iMatch As Long

Set rSO = Worksheets("SO").Cells(1, 1).CurrentRegion

With Target.TableRange1
.Interior.ColorIndex = xlAutomatic

For Each rRow In .Rows

iMatch = 0
On Error Resume Next
iMatch = Application.WorksheetFunction.Match(rRow.Cells(1, 2).Value, rSO.Columns(1), 0)
On Error GoTo 0

If iMatch > 0 Then
If rSO.Cells(iMatch, 11).Value = "Not Approved" Then
rRow.Interior.Color = vbYellow
End If
End If

Next

End With
Stop
End Sub

[paradise]

Thanx for your kind response.In column A it is not highlighting as enclosed in my workbook in post 4,however highlighting from B:K in Pivot Table is fine.

To elaborate in detail ,kindly note that,for B7:K7 and B9:K9 >>>> A7 is common,hence A7 should only get highlighted but here A9 is also highlighted which is an empty and I do not like here to get highlighted an empty portion for A column only.

Similarly,for B11:K11 it is highlighted as per condition which is fine.But in column A i.e A10 should get highlighted instead of an empty A11 becoz B11:K11 belongs to A10.

In case,for A12:K12 ,it is highlighted as per condition which is fine and perfect.

In addition to above mentioned,

I have more than One Pivot table having same structure,how can I run this.Should I paste the code in each worksheet or shall create a module ?

[Paul_Hossler]

Put this in the ThisWorkbook module and it will run for all PTs in the workbook



Option Explicit

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Dim rRow As Range
Dim rSO As Range
Dim iMatch As Long

Set rSO = Worksheets("SO").Cells(1, 1).CurrentRegion

If Not Target.PivotFields("Party Name").RepeatLabels Then Target.PivotFields("Party Name").RepeatLabels = True

With Target.TableRange1
.Interior.ColorIndex = xlAutomatic

For Each rRow In .Rows

iMatch = 0
On Error Resume Next
iMatch = Application.WorksheetFunction.Match(rRow.Cells(1, 2).Value, rSO.Columns(1), 0)
On Error GoTo 0

If iMatch > 0 Then
If rSO.Cells(iMatch, 11).Value = "Not Approved" Then
rRow.Interior.Color = vbYellow
End If
End If

Next

End With

End Sub

[paradise]

I have tested but repeating the labels in Column A makes presentation of Pivot table to be more ugly in case of large data.If possible without repeating labels,kindly do same like as enclosed in "Post 4".Rest your works are fine and perfect.

And thanx for your kind help.

[paradise]

I have tested but repeating the labels in Column A makes presentation of Pivot table to be more ugly in case of large data.If possible without repeating labels,kindly do same like as enclosed in "Post 4".Rest your works are fine and perfect.

And thanx for your kind help.

[Paul_Hossler]

Try this version





Option Explicit

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Dim rRow As Range
Dim rSO As Range
Dim iMatch As Long

Set rSO = Worksheets("SO").Cells(1, 1).CurrentRegion

With Target.TableRange1
.Interior.ColorIndex = xlAutomatic

For Each rRow In .Rows

iMatch = 0
On Error Resume Next
iMatch = Application.WorksheetFunction.Match(rRow.Cells(1, 2).Value, rSO.Columns(1), 0)
On Error GoTo 0

If iMatch > 0 Then
If rSO.Cells(iMatch, 11).Value = "Not Approved" Then
rRow.Cells(1, 2).Resize(1, rRow.Columns.Count - 1).Interior.Color = vbYellow
If Len(rRow.Cells(1, 1).Value) > 0 Then
rRow.Cells(1, 1).Interior.Color = vbYellow
Else
rRow.Cells(1, 1).End(xlUp).Interior.Color = vbYellow
End If
End If
End If

Next

End With

End Sub

[paradise]

That's awesome and fantastic. Heartily thanks.Now I am fully satisfied with your post 10.

One Last related to this.

Here,I have added a single data in SO sheet and refreshed the Pivot.So,in sheet PT-1, a new data appears, can this data which is in D12:K12 now further be highlighted and similar to other rows if data gets added to SO and PO sheet.I have highlighted with green for your kind reference. Since they belongs to "Not Approved" category i.e it belongs to B11.

Hope this would also get resolved by u finally.

[Paul_Hossler]

Try this version, also in the THisWorkbook module



Option Explicit

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Dim iRow As Long
Dim rRow As Range
Dim rSO As Range
Dim iMatch As Long

Set rSO = Worksheets("SO").Cells(1, 1).CurrentRegion

With Target.TableRange1
.Interior.ColorIndex = xlAutomatic

For Each rRow In .Rows

iMatch = 0
On Error Resume Next
iMatch = Application.WorksheetFunction.Match(rRow.Cells(1, 2).Value, rSO.Columns(1), 0)
On Error GoTo 0

If iMatch > 0 Then
If rSO.Cells(iMatch, 11).Value = "Not Approved" Then
rRow.Cells(1, 2).Resize(1, rRow.Columns.Count - 1).Interior.Color = vbYellow
If Len(rRow.Cells(1, 1).Value) > 0 Then
rRow.Cells(1, 1).Interior.Color = vbYellow
Else
rRow.Cells(1, 1).End(xlUp).Interior.Color = vbYellow
End If
End If
End If

Next

For iRow = 2 To .Rows.Count - 2

If .Cells(iRow, 4).Interior.Color = vbYellow And Len(.Cells(iRow + 1, 3).Value) = 0 Then
.Cells(iRow + 1, 4).Resize(1, .Columns.Count - 3).Interior.Color = vbYellow
End If
Next iRow

End With

End Sub

[paradise]

Splendid work. Thanx Thanx Thanx a lot for giving time to my query and resolving it.:peace::sparkle::sparkle: