Conditionally formatted chart

[tommy bak]

HI
I've been playing a little with the possibility to format a chart conditionally and I have got it working now.
My problem is that I would like it to be more flexible, but right now I seem to be a bit braindead and need some help
It should be more flexible on the numbers of conditions and corresponding colors.
Right now it's locked to 3 (bad, good, exelent)
I have made it as a classmodule, becaurse I want to include it in a couple of workbooks. As it is my first classmodule, please give some feedback.
[Edit] : Complete file is attached

Class module:

Option Explicit
'repaints charts within 2 limits in 3 different colors
Public WithEvents Graph As Chart
'Limits for coloring
Dim L2 As Long, L3 As Long
'Colors for each section
Dim C1 As Long, C2 As Long, C3 As Long
'holder for series-number
Dim S As Long

Private Sub Graph_Calculate()
Dim y As Long
Dim c As Range
Dim rngChart As Range
Dim vaGetRange
'Split the chartformula at ,
vaGetRange = Split(Graph.SeriesCollection(S).Formula, ",")
'choose the text between 2 and 3 comma;
Set rngChart = Range(vaGetRange(2))
y = 0
'for each cell in the area rngChart find the value and color the chart's
'point with the corresponding color
For Each c In rngChart
    y = y + 1
    With Graph.SeriesCollection(S).Points(y).Interior
        'this is where I would like to be able to insert multible conditions
        Select Case c.Value
            Case Is < L2: .ColorIndex = C1
            Case L2 To L3: .ColorIndex = C2
            Case Is > L3: .ColorIndex = C3
            Case Else: Exit Sub
        End Select
    End With
Next
End Sub
 
Sub Limits(Low, Hi)
L2 = Low
L3 = Hi
End Sub
 
Sub Colors(Color_Low, Color_Med, Color_Hi)
C1 = Color_Low
C2 = Color_Med
C3 = Color_Hi
End Sub
 
Property Let Serie(Number As Long)
S = Number
End Property
 
Property Get Serie() As Long
Serie = S
End Property
 
Standard module:

Option Explicit
'create new GraphClass object
Dim clsGr1 As New clsGraph '1. chart
Dim clsGr2 As New clsGraph '2. chart
 
Sub InitializeChart()
'choose the chart to be colored
'call this sub from Workbook_Open or manually
With clsGr1
    Set .Graph = shUnd.ChartObjects(1).Chart
    .Serie = 1
    .Limits 3, 4
    .Colors 3, 6, 4
End With
With clsGr2
    Set .Graph = shUnd.ChartObjects(2).Chart
    .Serie = 1
    .Limits 3, 4
    .Colors 3, 6, 4
End With
End Sub

TIA
Tommy Bak

[Juan Pablo Gonz?lez]

Tommy,

Altough I can see the point of using a class module for this, I think using Excel's builtin tools might be preferable (Well, ok, I would prefer that...). Some links that show how to do that:

http://www.peltiertech.com/Excel/Cha...nalChart1.html

http://www.peltiertech.com/Excel/Cha...nalChart2.html

and one example at MrExcel:

http://www.mrexcel.com/board2/viewtopic.php?t=56489

[Andy Pope]

Hi Tommy,

If you want variable limits you will have to change the select case approach to one that checks for values between 2 values.
I have made some mods to your class and Initialize routine. Hopefully the comments and code are self explanatory. If not or you have any other questions post back.

Option Explicit
'Class made by Tommy Bak aug-04
'repaints charts within 2 limits in 3 different colors
Public WithEvents Graph As Chart
'Limits for coloring
Dim L2 As Long, L3 As Long
'Colors for each section
Dim C1 As Long, C2 As Long, C3 As Long
'holder for series-number
Dim S As Long

' local storage of limits and colorindexes
Private m_sngLimits() As Single
Private m_lngColorIndex() As Long
Public Sub ClearLimits()
' clear any information
    ReDim m_sngLimits(2, 0) As Single
    ReDim m_lngColorIndex(0) As Long
End Sub

Public Property Let ColorIndexes(Index As Long, ColourIndex As Long)
' Store colorindex of specified set of limits
    If Index <= UBound(m_lngColorIndex) Then
        ' only store if the limit has already been added
        m_lngColorIndex(Index) = ColourIndex
    End If
End Property

Public Property Get ColorIndexes(Index As Long) As Long
' return Colorindex of specified limits
    ColorIndexes = m_lngColorIndex(Index)
End Property
Public Property Get LimitCount() As Long
' return number of limits currently stored
    LimitCount = UBound(m_sngLimits, 2)
End Property

Public Property Get LowerLimit(Index As Long) As Single
' return lower limit
    If Index <= UBound(m_sngLimits, 2) Then
        LowerLimit = m_sngLimits(1, Index)
    End If
End Property
Public Property Get UpperLimit(Index As Long) As Single
' return lower limit
    If Index <= UBound(m_sngLimits, 2) Then
        UpperLimit = m_sngLimits(2, Index)
    End If
End Property

Private Sub Class_Initialize()
    ReDim m_sngLimits(2, 0) As Single
End Sub

Private Sub Graph_Calculate()
Dim y As Long
Dim c As Range
Dim rngChart As Range
Dim vaGetRange
Dim lngIndex As Long

    'Split the chartformula at ,
    vaGetRange = Split(Graph.SeriesCollection(S).Formula, ",")
    'choose the text between 2 and 3 comma;
    Set rngChart = Range(vaGetRange(2))
    y = 0
    'for each cell in the area rngChart find the value and color the chart's
    'point with the corresponding color
    For Each c In rngChart
        y = y + 1
        With Graph.SeriesCollection(S).Points(y).Interior
            
            For lngIndex = 1 To UBound(m_sngLimits, 2)
                If c.Value >= m_sngLimits(1, lngIndex) And c.Value < m_sngLimits(2, lngIndex) Then
                    .ColorIndex = m_lngColorIndex(lngIndex)
                End If
            Next            
'            Select Case c.Value
'                Case Is < L2: .ColorIndex = C1
'                Case L2 To L3: .ColorIndex = C2
'                Case Is > L3: .ColorIndex = C3
'                Case Else: Exit Sub
'            End Select
        End With
     Next
End Sub
Sub Limits(Low, Hi)
L2 = Low
L3 = Hi
End Sub

Sub Colors(Color_Low, Color_Med, Color_Hi)
C1 = Color_Low
C2 = Color_Med
C3 = Color_Hi
End Sub
Property Let Series(Number As Long)
S = Number
End Property
Public Sub AddLimit(Index As Integer, GreaterOrEqualTo As Single, LessThan As Single, ColourIndex As Long)
' add a set of limits and its colorindex
    If Index > UBound(m_sngLimits, 2) Then
        ' create space in array if required
        ReDim Preserve m_sngLimits(2, Index) As Single
        ReDim Preserve m_lngColorIndex(Index) As Long
    End If
    ' store values
    m_sngLimits(1, Index) = GreaterOrEqualTo
    m_sngLimits(2, Index) = LessThan
    m_lngColorIndex(Index) = ColourIndex
End Sub
Property Get Series() As Long
Series = S
End Property

Option Explicit
'create new GraphClass object
Dim clsGr1 As New clsGraph  '1. chart
Dim clsGr2 As New clsGraph  '2. chart

Sub InitializeChart()
    'choose the chart to be colored
    'call this sub from Workbook_Open or manually
    With clsGr1
        Set .Graph = shUnd.ChartObjects(1).Chart
        .Series = 1
        .ClearLimits
        .AddLimit 1, 0, 1, 3
        .AddLimit 2, 1, 2, 6
        .AddLimit 3, 2, 3, 4
        .AddLimit 4, 3, 4, 21
        .AddLimit 5, 4, 5, 18
        .AddLimit 6, 5, 999, 32
'        .Limits 3, 4
'        .Colors 3, 6, 4
    End With
    
    With clsGr2
        Set .Graph = shUnd.ChartObjects(2).Chart
        .Series = 1
        .ClearLimits
        .AddLimit 1, 3, 3.4, 3
        .AddLimit 2, 3.4, 3.8, 6
        .AddLimit 3, 3.8, 4, 4
        .AddLimit 4, 4, 999, 24
'       .Limits 3, 4
'        .Colors 3, 6, 4
    End With
End Sub

[tommy bak]

Hi Juan Pablo and Andy
Thanks for your repplyes (and opinons )

Juan Pablo ->

I think using Excel's builtin tools might be preferable

you're right, if it's one simple chart with one or two dataranges, I would use your approach. I've seen your link at mrexcel before and used it :-)
[Edit] tryed it out again,and was in fact quite simple using the names i allready had defined.

Andy -> that's exactly what I was looking for. Beautyful piece of code.
Checked it and it's working very nice.
I'm sorry I didn't find that solution myself. :-)
btw. Public Property Let ColorIndexes is an extra way of inputting the colors, right ?

Thanks again, both of you. Happy to get answers from 2 superguru's ....

BR
Tommy Bak