Seamus2626
asked on
Lookup pivot and highlight
Hi,
Im loking for some code that will look at the data in ColA in one pivot and if there is a matching entry in ColA in a pivot on another tab, highlight the whole row green, if it is not a match, highlight it red.
I did the first as an example
Thanks
Seamus
test.zip
Im loking for some code that will look at the data in ColA in one pivot and if there is a matching entry in ColA in a pivot on another tab, highlight the whole row green, if it is not a match, highlight it red.
I did the first as an example
Thanks
Seamus
test.zip
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
One question Dave, the colours expand to col G, however the pivots shrink and expand with new data. There is always a grand total for for Columns, so could you amend so the colouring only goes as far as "Grand Total"
Thanks
Seamus
Thanks
Seamus
Sure. It searches for "Grand Total" on row 4, if not found, then uses last column on row 4. Change the row number if you move the pivot table:
See attached.
Dave
match-pivots-r2.xls
Option Explicit
Sub matchPivots()
Dim wkb As Workbook
Dim wksA As Worksheet
Dim wksB As Worksheet
Dim rng As Range
Dim r As Range
Dim rFind As Range
Dim rColor As Range
Dim lastCol As Long
Set wkb = ThisWorkbook
Set wksA = wkb.Sheets("ASPA Pivot")
Set wksB = wkb.Sheets("Sophis Pivot")
Set rng = wksA.Range("A5", wksA.Range("A" & Rows.Count).End(xlUp).Offset(-1, 0))
On Error Resume Next
lastCol = wksA.Range("4:4").Find(what:="Grand Total", LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlNext).Column
If lastCol = 0 Then
lastCol = wksA.Cells(4, Columns.Count).End(xlToLeft).Column
End If
On Error Resume Next
For Each r In rng
Set rColor = wksA.Range(r, wksA.Cells(r.Row, lastCol))
Set rFind = wksB.Range("A:A").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
If Not rFind Is Nothing Then
rColor.Interior.Color = vbGreen
Else
rColor.Interior.Color = vbRed
End If
Next r
End Sub
See attached.
Dave
match-pivots-r2.xls
ASKER
Seamus