Dynamically highlight bar color based on drop down list value

Question

I want to iterate through the x values (categories) in the pivot chart.
If the x value equals cell C4 then make that bar color red.
Otherwise, the bars should be blue.

This doesn't do anything:

Sub color_chart()

    Dim c As Chart
    Dim s As Series
    Dim iPoint As Long
    Dim nPoint As Long

    Charts("Chart 2").Activate
    Set c = ActiveChart
    Set s = c.SeriesCollection(1)

    nPoint = s.Points.Count
    For iPoint = 1 To nPoint
        If s.XValues(iPoint) = Range("C4").Value Then
            s.Points(iPoint).Interior.Color = RGB(255, 78, 0)
        End If
    Next iPoint

End Sub

More info:
Is there a way to make the color red on the bar which corresponds to the name that is chosen in the drop down list?
For example, for employee name let's say I choose Judith Blake from the drop down data validation list. I want the bar of Judith Blake in the pivot chart to be red. I want this to be done dynamically. So if I choose James Lewis for example in the drop down, the James Lewis bar becomes red and all others blue.
For reference, the chart is called Chart3 and the corresponding pivot table is PivotTable2.

Worksheet Image

Answer 1

Here (read only)/screenshots refer:

In action

Key features

• Single drop down list allows one to either remove or add the desired name to the 'different bar colour-series'
• Multiple entries (with common names) can be dealt with using single validation drop down tool (validaiton list)
• Dynamic lists (varies in length, bespoke functions that extend downt to final 'non-blank' cell (i.e. ranges need not be contiguous)

If this is what you're looking to achieve - then see link / below in more detail:

*Note: ranges B5: c12 = user input/static entries to begin wih:

---

Helper data: complete list, unselected and selected, formulated as follows:

complete list (cell G5, array function)

=FILTER(C5:C12,B5:B12<>"")

unselected (cell H5):

=FILTER(G5#,--NOT(ISNUMBER(MATCH(G5#,$I$5:$I$12,0))))

---

Named ranges:

Not critical - but for parsimony, VB etc. may reference following:

complete (name), refers to:

=Sheet1!$G$5:OFFSET(Sheet1!$G$5,MAX(FILTER(SEQUENCE(ROWS(Sheet1!$G:$G),1,-ROW(Sheet1!$G$5)+1,1),--(Sheet1!$G:$G<>""))),0)

selected, refers to:

=IF(Sheet1!$I$5="",Sheet1!$I$5,Sheet1!$I$5:OFFSET(Sheet1!$I$5,MAX(FILTER(SEQUENCE(ROWS(Sheet1!$I:$I),1,-ROW(Sheet1!$I$5)+1,1),--(Sheet1!$I:$I<>""))),0))

unselected (name), refers to:

=IF(Sheet1!$H$5="",Sheet1!$H$5,Sheet1!$H$5:OFFSET(Sheet1!$H$5,MAX(FILTER(SEQUENCE(ROWS(Sheet1!$H:$H),1,-ROW(Sheet1!$H$5)+1,1),--(Sheet1!$H:$H<>""))),0))

These are dynamic / variable length ranges (will always select down to final non-blank cell; if no populated cell in respective range, the cell where the first such entry would occur is selected)

drop-down (name), refers to:

=Sheet1!$L$4

---

Graph data:

Comprises col1_sel and col2_sel (colours 1/2 resp) as follows:

col1_sel

=LET(x_,IFERROR(INDEX($B$5:$B$12,MATCH($G5#,H5#,0)),""),IF(ISERROR(--x_),"",B5:B12))

col2_sel

=IF(D5#="",B5:B12,"")

---

VB code:

Finally: see here for how to create macro pertainin to sheet, to be executed whenever specified target range of cell(s) is altered.

Below - I include bespoke/tailored code for the case in question:

Private Sub Worksheet_Change(ByVal Target As Range)
    If (Not Intersect(Target, Range("drop_down")) Is Nothing) And (Range("drop_down").Value <> "") Then
        ActiveSheet.Calculate
        If Range("i5").Value = "" Then
            Range("i5").Value = Range("drop_down").Value
            'Range("drop_down").ClearContents
            Exit Sub
        End If
        k = 1
        For Each c In Range("selected").Cells

            If Range("drop_down").Value = c.Value Then
                c.ClearContents
                k = 0
            End If
        Next
        If k = 0 Then
            ActiveSheet.Sort.SortFields.Add2 Key:=Range("selected"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            ActiveSheet.Sort.Apply

            'Range("drop_down").ClearContents
            Range("b3:i15").Calculate
            Exit Sub
        Else:
            If Range("i5").Value = "" Then
                Range("i5").Select
            Else
                Range("i4").End(xlDown).Offset(1).Select
            End If
            Selection.Value = Range("drop_down").Value
            'Range("drop_down").ClearContents
            Range("b3:i15").Calculate
        End If
        
    End If

End Sub

## ̿̿ ̿̿ ̿’̿’\̵͇̿̿\З= ( ▀ ͜͞ʖ▀) =Ε/̵͇̿̿/’̿’̿ ̿ ̿̿ ̿̿ ̿̿ ##

---

Alternatively

Within the Private Sub Worksheet_Change VBA code above, you could include something like this to cyce through the bars and colour them as req (instead of the 'hack' I provide above which relies upon two series being defined etc.

ActiveSheet.ChartObjects("Chart 2").Activate
With ActiveChart.SeriesCollection(1)
    For i = 1 To 8
        If Range("d5").Offset(i - 1).Value = "" Then
            .Points(i).Select
            With Selection.Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 255, 0)
                .Solid
            End With
        
        Else:
            .Points(i).Select
            Selection.Format.Fill.Visible = msoTrue
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 112, 0)
            .Solid
        End With
        
        End If
            
    Next
End With

This still requires helper tables to identify col_1 vs _2 etc.

---

Pre-requsities:

• Office 365 compatible Excel (similar can be achieved without, but specific functions adopted here happen to rely upon this)

---