• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 264
  • Last Modified:

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
0
Seamus2626
Asked:
Seamus2626
  • 2
  • 2
1 Solution
 
dlmilleCommented:
I would use this code:

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

    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))
    
    For Each r In rng
        Set rColor = wksA.Range(r, wksA.Cells(r.Row, "G"))
        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

Open in new window


See attached.

Dave
match-pivots-r1.xls
0
 
Seamus2626Author Commented:
Thanks Dave!

Seamus
0
 
Seamus2626Author Commented:
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
0
 
dlmilleCommented:
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:

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

Open in new window


See attached.

Dave
match-pivots-r2.xls
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now