Format Chart Based on Point Values
A recent post to the Microsoft Excel Charting Discussion Group asks . . . how can I change the pattern of a column based on that column's value. Assuming an embedded chart, I responded with the following procedure:
Sub ChangePatterns()
Application.ScreenUpdating = False
Dim Cht As Chart
Dim Srs As Series
Dim Pts As Points
Set Cht = ActiveChart
Set Srs = Cht.SeriesCollection(1)
Set Pts = Srs.Points
Cnt = 1
For Each Pt In Srs.Values
Srs.Points(Cnt).Select
'Sales greater than 10000
If Pt > 10000 Then
With Selection
.Fill.Visible = True
.Fill.Patterned Pattern:=msoPatternWideUpwardDiagonal
.Fill.ForeColor.SchemeColor = 42
.Fill.BackColor.SchemeColor = 34
End With
'Sales less than or equal to 10000
ElseIf Pt <= 10000 Then
With Selection
.Fill.Visible = True
.Fill.Patterned Pattern:=msoPatternLightHorizontal
.Fill.ForeColor.SchemeColor = 43
.Fill.BackColor.SchemeColor = 22
End With
End If
Cnt = Cnt + 1
Next Pt
ActiveChart.Deselect
End Sub
-- Just thought I would document it for my own reference. Is there a better way to write this?
Not sure it’s better but it is differently, slightly ;)
The values to use are stored in variables and then applied.
No selection of point is required.
Added checking for empty and N/A cells.
Sub ChangePatterns()
Dim Cht As Chart
Dim Srs As Series
Dim Pt As Variant
Dim Cnt As Long
Dim lngPattern As MsoPatternType
Dim lngForeScheme As Long
Dim lngBackScheme As Long
Application.ScreenUpdating = False
Set Cht = ActiveChart
Set Srs = Cht.SeriesCollection(1)
Cnt = 1
For Each Pt In Srs.Values
' handle empty or N/A cells
If Not IsError(Pt) Then
If Pt > 10000 Then
'Sales greater than 10000
lngPattern = msoPatternWideUpwardDiagonal
lngForeScheme = 42
lngBackScheme = 34
Else
'Sales less than or equal to 10000
lngPattern = msoPatternLightHorizontal
lngForeScheme = 43
lngBackScheme = 22
End If
' apply values
With Srs.Points(Cnt).Fill
.Visible = True
.Patterned lngPattern
.ForeColor.SchemeColor = lngForeScheme
.BackColor.SchemeColor = lngBackScheme
End With
End If
Cnt = Cnt + 1
Next Pt
ActiveChart.Deselect
End Sub