Good evening,
I have on a sheet with several graphs and I would like to execute the
procedure below automatically.

In advance thank you for the assistance
Yves



Sub ColorColumns()

Dim vntValues As Variant
Dim intSeries As Integer
Dim intPoint As Integer

With ActiveChart
For intSeries = 1 To .SeriesCollection.Count
With .SeriesCollection(intSeries)
vntValues = .Values
For intPoint = 1 To .Points.Count
If vntValues(intPoint) < 60 Then
..Points(intPoint).Interior.Color = vbRed
ElseIf vntValues(intPoint) = 60 And vntValues(intPoint) < 80 Then
..Points(intPoint).Interior.Color = vbYellow
Else
..Points(intPoint).Interior.Color = vbGreen
End If
Next
End With
Next
End With

End Sub

Hi,

Assuming you just need your code to process all charts on the sheet
rather than just the active one.

'--------------------------------
Sub ColorColumns()

Dim vntValues As Variant
Dim intSeries As Integer
Dim intPoint As Integer
Dim objChart As ChartObject

For Each objChart In ActiveSheet.ChartObjects
With objChart.Chart
For intSeries = 1 To .SeriesCollection.Count
With .SeriesCollection(intSeries)
vntValues = .Values
For intPoint = 1 To .Points.Count
If vntValues(intPoint) < 60 Then
.Points(intPoint).Interior.Color = vbRed
ElseIf vntValues(intPoint) = 60 And _
vntValues(intPoint) < 80 Then
.Points(intPoint).Interior.Color = vbYellow
Else
.Points(intPoint).Interior.Color = vbGreen
End If
Next
End With
Next
End With
Next

End Sub
'----------------

If you want to run the automatically you will need to call the routine
from a worksheet event. Something like this placed in the sheet object

Private Sub Worksheet_Change(ByVal Target As Range)

' check if cell is in range containing chart data
If Not Intersect(Target, Range("A1:B10")) Is Nothing Then
ColorColumns
End If

End Sub

Cheers
Andy

If wrote:
Good evening,
I have on a sheet with several graphs and I would like to execute the
procedure below automatically.

In advance thank you for the assistance
Yves



Sub ColorColumns()

Dim vntValues As Variant
Dim intSeries As Integer
Dim intPoint As Integer

With ActiveChart
For intSeries = 1 To .SeriesCollection.Count
With .SeriesCollection(intSeries)
vntValues = .Values
For intPoint = 1 To .Points.Count
If vntValues(intPoint) < 60 Then
.Points(intPoint).Interior.Color = vbRed
ElseIf vntValues(intPoint) = 60 And vntValues(intPoint) < 80 Then
.Points(intPoint).Interior.Color = vbYellow
Else
.Points(intPoint).Interior.Color = vbGreen
End If
Next
End With
Next
End With

End Sub



--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info