chart name begins with VBA

[snowman1976]

I have the following VBA that works well (colors bars based on named ranges). I want to make it smarter and apply it to any graph that starts with the name 'BINCHART'. I need to expand this so I can have multiple graphs that change color based on the set conditions of the named cells green and red. How do I change this so its 'for all charts that start with the name binchart' (I just plan on naming them binchart1, binchart2, etc)

as always any help is appreciated


Sub color_graphs()

Dim chartIteratorX As Integer, pointIteratorX As Integer, _
seriesarrayX() As Variant
seriesarrayX = ActiveWorkbook.Sheets("Graphs").ChartObjects("BINCHART"). _
Chart.SeriesCollection(1).Values
For pointIteratorX = 1 To UBound(seriesarrayX)
If seriesarrayX(pointIteratorX) > Range("red") Then
ActiveWorkbook.Sheets("Graphs").ChartObjects("BINCHART"). _
Chart.SeriesCollection(1).Points(pointIteratorX).Interior.Color = _
RGB(255, 0, 0)
Else
If seriesarrayX(pointIteratorX) <= Range("green") Then
ActiveWorkbook.Sheets("Graphs").ChartObjects("BINCHART"). _
Chart.SeriesCollection(1).Points(pointIteratorX).Interior.Color = _
RGB(0, 176, 80)
Else
ActiveWorkbook.Sheets("Graphs").ChartObjects("BINCHART"). _
Chart.SeriesCollection(1).Points(pointIteratorX).Interior.Color = _
RGB(255, 255, 0)

End If
End If
Next pointIteratorX
End Sub

 

[pgc01]

Hi

Try:

Sub ColorCharts()
Dim chto As ChartObject

' if the chart name starts with BINCHART color it
For Each chto In ActiveWorkbook.Sheets("Graphs").ChartObjects
   If UCase(Left(chto.Name, Len("BINCHART"))) = "BINCHART" Then Call ColorChart(chto.Chart)
Next chto

End Sub

Sub ColorChart(cht As Chart)
Dim ser As Series
Dim lPt As Long, lColor As Long

Set ser = cht.SeriesCollection(1)
For lPt = 1 To ser.Points.Count
    Select Case ser.Values(lPt)
        Case Is > Range("red")
            lColor = RGB(255, 0, 0)
        Case Is <= Range("green")
            lColor = RGB(0, 176, 80)
        Case Else
            lColor = RGB(255, 255, 0)
    End Select
    ser.Points(lPt).Interior.Color = lColor
Next lPt
End Sub

 

[snowman1976]

that worked great, thanks for the help !

 

[pgc01]

You're welcome.