Change Shape Color Based on Pivot Table Result

[Mikee_likes_excel]

Greetings,

I am looking for VBA code to change color of multiple shapes in sheet2 automatically based of the result of a pivot table. I have some code written but it fails to perform as required. My goal is to name every shape based on table in sheet1 and as you change the filter on the pivot table any body part that appears in the pivot table when filtered will turn red if it is not a result in the pivot table the body part stays green. I have named several body part shapes such as Head, Neck, Chest, Shoulderright, etc. I would like it ... so if we use the pivot table filter to sort for “Jan” all body parts filtered will turn red otherwise stay green. Same when selecting any month or all months. I hope you can help as I have spent hours searching for some code that would work. I may be approaching this wrong and if pivot table is a problem I am open to any other method such as range names and formulas if required. I have uploaded a sample file and have VBA code attached with a "Worksheet_SelectionChange" sub as well. Password is "safety"

Thank you for your kindness and expertise.
----------------------------------------------------------------------------
Mod edit: Question moved to VBA forum

 

[Nebu]

Hi:

Your file is password protected. Please remove the password and upload again for ppl to help.

Thanks

 

[Mikee_likes_excel]

Sorry - password removed as requested.

 

[Nebu]

Hi:

Find the attached.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False

Dim rng As Range, fnd As Range

Set rng = Me.Range("L8:L" & Me.Cells(Rows.Count, "L").End(xlUp).Row)

Set fnd = rng.Find(What:="Head")
  If Not fnd Is Nothing Then
      With Me.Shapes("Head")
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
      End With
    Else
        With Me.Shapes("Head")
            .Fill.ForeColor.RGB = RGB(0, 255, 0)
        End With
    End If
   
Set fnd = rng.Find(What:="Neck")
  If Not fnd Is Nothing Then
      With Me.Shapes("Neck")
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
      End With
    Else
        With Me.Shapes("Neck")
            .Fill.ForeColor.RGB = RGB(0, 255, 0)
        End With
    End If
Application.ScreenUpdating = True

End Sub

I have done it for Head and Neck replicate it for other body parts.

Thanks

 

[Mikee_likes_excel]

Works perfect! Simple but brilliant.
You are a true Jedi master my friend.
Thank you.