VBA color chart series if value is negative

[cacos]

Hi everyone, hope you can help me on this one:


I'm trying to color all chart series on my sheet according to their value. If negative, certain color, if positive other.


So far this is what I have:

[pre]

For Each cChart In Sheet2.ChartObjects
With cChart.Chart

.SeriesCollection(1).Interior.Color = RGB(255, 0, 0)

End With

Next cChart

[/pre]

I'm missing a bit of code that changes the color depending on the value of the series.


Thanks!

 

[NARAYANK991]

Hi ,


A series can have both positive and negative values ; do you mean that a series is a certain colour , or do you mean that each column or bar of the chart , will take on the appropriate colour , depending on whether it is positive or negative ?


Narayan

 

[cacos]

That's right sorry, Points should change color depending on their value.

 

[NARAYANK991]

Hi ,


Try this :

[pre]

Public Sub Color_Chart_Points()
Dim POS_COLOR As Long, NEG_COLOR As Long
Dim i As Integer

POS_COLOR = RGB(0, 255, 0)
NEG_COLOR = RGB(255, 0, 0)

For Each cChart In Sheet1.ChartObjects
With cChart.Chart.SeriesCollection(1)
point_values = .Values
For i = 1 To .Points.Count
If point_values(i) > 0 Then
.Points(i).Format.Fill.ForeColor.RGB = POS_COLOR
Else
.Points(i).Format.Fill.ForeColor.RGB = NEG_COLOR
End If
Next
End With
Next cChart
End Sub

[/pre]
Narayan

 

[Hui]

The following will work with all charts and Series on the current sheet regardless of chart type

[pre]

Sub NegativeRed()
'Petr Bezucha, 2010
'Sub shades markers, lines or bars green or red according to positive or negative values, also trends in line chart can be followed
'A series must be selected before deployment.
'Both interior and border colors are set up.
'
'Ian Huitson, 2013
'Added ability to loop through all Charts and Series on the Active Sheet
'

Dim ChT As String, ChType As String, ErrMsg As String, _
I As Long, MarkCol As Long

Dim myCht As ChartObject
Dim mySeries As Series
Dim seriesCol As SeriesCollection

ErrMsg = "Error"
On Error GoTo ErrExit

j = 1
For Each myCht In ActiveSheet.ChartObjects
Set seriesCol = myCht.Chart.SeriesCollection
For Each mySeries In seriesCol
Set mySeries = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(j)

Select Case mySeries.ChartType
Case xlXYScatter, xlXYScatterLines, xlXYScatterLinesNoMarkers, xlXYScatterSmooth, _
xlXYScatterSmoothNoMarkers, xl3DLine, xlLine, xlLineMarkersStacked, xlLineStacked
ChType = "XY"
Case 51 To 59
ChType = "Bar"
Case Else
ErrMsg = "This chart cannot be adapted in this way": GoTo ErrExit
End Select
Application.ScreenUpdating = False
For I = 1 To UBound(mySeries.Values)
With mySeries.Points(I)
On Error GoTo Skip

If mySeries.Values(I) >= 0 Then
MarkCol = RGB(0, 255, 0) 'Green
Else
MarkCol = RGB(255, 0, 0) 'Red
End If

If ChType = "XY" Then
.MarkerForegroundColor = MarkCol
.MarkerBackgroundColor = MarkCol
ElseIf ChType = "Bar" Then
.Border.Color = MarkCol
.Interior.Color = MarkCol
End If
End With
Skip:
Resume Next
Next I
j = j + 1
Next mySeries

Next myCht

Application.ScreenUpdating = True
Exit Sub
ErrExit:
MsgBox ErrMsg, vbOKOnly, "Negative red"
End Sub

[/pre]

 

[cacos]

Both were perfect!


That was awesome thanks a lot. It really helps with my education in VBA.

 

[Hui]

Cacos


I have moved this into the Vault

I hope you don't mind