PDA

View Full Version : Solved: Conditionally formatted chart



tommy bak
08-23-2004, 08:28 AM
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 :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
08-24-2004, 06:38 AM
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/Charts/ConditionalChart1.html

http://www.peltiertech.com/Excel/Charts/ConditionalChart2.html

and one example at MrExcel:

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

Andy Pope
08-24-2004, 07:42 AM
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
08-24-2004, 08:53 AM
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.:bink:

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