Solved: XLDs CFColorIndex and Chart sheets

[Onetrack]

I have used XLD's code to enable conditional formatting to be applied to a chart (2007). This works for FormatConditions that are both numerical and text conditions.

Ideally, when the Chart is activated then the chart should refelect the same colours as determined by the conditional formatting of the source chart data.

However, it appears that the code has to always activate the first cell of the conditional format area in order to work correctly - hence the "Sheet19.Activate : Range("C2").Activate" cludge below:

-------------
For Each myseries In ActiveChart.SeriesCollection
s = Split(myseries.Formula, ",")(2)
vntValues = myseries.Values
For i = 1 To UBound(vntValues)
Sheet19.Activate
Range("C2").Activate ' First Cell of CF - REF answers.microsoft.com/en-us/office/forum/office_2007-excel/testing-if-a-cell-or-range-of-cells-is/b05a6016-df7f-426a-b8b4-9a43b30bc95b?page=2&msgId=4d194dd2-1dec-4234-bd06-e44b87474a04

curColor = CFColorindex(Sheet19.Range(s).Cells(i)) ' XLD Routine
Debug.Print "curColor:" & curColor
myseries.Points(i).Interior.ColorIndex = curColor
Next i
Next myseries
------------------------------
Ideally I'd like the chart colours to be update on the Chart_Activate event.

Please can anyone advise on this? [I have a sample workbook available, but there's no option shown to me to include this.]

[Bob Phillips]

You can add an attachment by clicking the 'Go Advanced' button. I think it would help.

[Onetrack]

Attachment added.

[Bob Phillips]

I am afraid I am not going to be able to help, that file keeps crashing my Excel when I try to Enable it.

[Onetrack]

File now saved in 2003 format. Hope that helps...

[Onetrack]

XLD - any chance you could have another go today~?:dunno BR, JohnS

[Bob Phillips]

I did yesterday, the file was still an xlsm and I got the same problem.

[Onetrack]

.xls uploaded now :bow:

[Bob Phillips]

Right, got it at last :)

The colours on that chart do seem to update, but the problem is that when you activate it, that kludge takes us back to the colour definition sheet, which isn't much help.

I have amended the ChartColor procedure to force it onto the chart sheet. I hope this does what you need.

Sub ChartColor()
' ******FEEL FREE TO DISTRIBUTE THIS PROGRAM BUT PLEASE LEAVE THE COMMENTS******
'
'Program developed by Chris Umphlett, 8/13/2011
'available at: http://chrisumphlett.com/?p=168
'this macro will change the fill color of each data point based on the fill color _
of the observation in the data table
'adapted from: _
Data Pig @ http://datapigtechnologies.com/blog/index.php/ _
automatically-set-chart-series-colors-to-match-source-cell-colors/#respond _
OzGrid Forum @ http://www.ozgrid.com/forum/showthread.php?t=141204&highlight=vntValues

Dim cht As ChartObject
Dim i As Integer
Dim vntValues As Variant
Dim s As String
Dim myseries As Series
Dim X As Integer
Dim start As Date
start = Now()

Dim curColor As Long

Application.ScreenUpdating = False
Debug.Print "ActiveSheet.ChartObjects.Count " & ActiveSheet.ChartObjects.count

If TypeName(ActiveSheet) = "Chart" Then
Debug.Print "It's a chart sheet"
'For Each cht In ActiveSheet.ChartObjects
For Each myseries In ActiveChart.SeriesCollection
s = Split(myseries.Formula, ",")(2)
vntValues = myseries.Values
For i = 1 To UBound(vntValues)
Sheet19.Activate
Range("C2").Activate ' First Cell of CF - REF http://answers.microsoft.com/en-us/office/forum/office_2007-excel/testing-if-a-cell-or-range-of-cells-is/b05a6016-df7f-426a-b8b4-9a43b30bc95b?page=2&msgId=4d194dd2-1dec-4234-bd06-e44b87474a04
curColor = CFColorindex(Sheet19.Range(s).Cells(i)) ' XLD Routine
Debug.Print "curColor:" & curColor
myseries.Points(i).Interior.ColorIndex = curColor
Next i
Next myseries
'Next cht

Application.EnableEvents = False
Chart2.Activate
Application.EnableEvents = True
Else
For Each cht In ActiveSheet.ChartObjects
For Each myseries In cht.Chart.SeriesCollection
s = Split(myseries.Formula, ",")(2)
vntValues = myseries.Values
For i = 1 To UBound(vntValues)
Sheet19.Activate
Range("C2").Activate ' First Cell of CF - REF http://answers.microsoft.com/en-us/office/forum/office_2007-excel/testing-if-a-cell-or-range-of-cells-is/b05a6016-df7f-426a-b8b4-9a43b30bc95b?page=2&msgId=4d194dd2-1dec-4234-bd06-e44b87474a04
curColor = CFColorindex(Sheet19.Range(s).Cells(i)) ' XLD Routine
Debug.Print "curColor:" & curColor
myseries.Points(i).Interior.ColorIndex = curColor
Next i
Next myseries
Next cht
End If
Debug.Print "Time taken:" & DateDiff("s", start, Now()) & "s"
End Sub

[Onetrack]

OK - thanks for that XLD.

It would be really good if the code was generic so that any chart could call the ChartColor routine rather than being hard coded. So the following would have to be dynamic rather than hard coded as present

Sheet19.Activate
Range("C2").Activate
Chart2.Activate

The trouble is - I don't know how to do that...:banghead:

[Bob Phillips]

Sub ChartColor()
' ******FEEL FREE TO DISTRIBUTE THIS PROGRAM BUT PLEASE LEAVE THE COMMENTS******
'
'Program developed by Chris Umphlett, 8/13/2011
'available at: http://chrisumphlett.com/?p=168
'this macro will change the fill color of each data point based on the fill color _
of the observation in the data table
'adapted from: _
Data Pig @ http://datapigtechnologies.com/blog/index.php/ _
automatically-set-chart-series-colors-to-match-source-cell-colors/#respond _
OzGrid Forum @ http://www.ozgrid.com/forum/showthread.php?t=141204&highlight=vntValues

Dim chtSheet As Object
Dim cht As ChartObject
Dim i As Integer
Dim vntValues As Variant
Dim s As String
Dim myseries As Series
Dim X As Integer
Dim start As Date
start = Now()

Dim curColor As Long

Application.ScreenUpdating = False
Debug.Print "ActiveSheet.ChartObjects.Count " & ActiveSheet.ChartObjects.count

If TypeName(ActiveSheet) = "Chart" Then

Set chtSheet = ActiveSheet

Debug.Print "It's a chart sheet"
'For Each cht In ActiveSheet.ChartObjects

For Each myseries In ActiveChart.SeriesCollection

s = Split(myseries.Formula, ",")(2)
vntValues = myseries.Values
For i = 1 To UBound(vntValues)

Sheet19.Activate
Range("C2").Activate ' First Cell of CF - REF http://answers.microsoft.com/en-us/office/forum/office_2007-excel/testing-if-a-cell-or-range-of-cells-is/b05a6016-df7f-426a-b8b4-9a43b30bc95b?page=2&msgId=4d194dd2-1dec-4234-bd06-e44b87474a04
curColor = CFColorindex(Sheet19.Range(s).Cells(i)) ' XLD Routine
Debug.Print "curColor:" & curColor
myseries.Points(i).Interior.ColorIndex = curColor
Next i
Next myseries
'Next cht

Application.EnableEvents = False
chtSheet.Activate
Application.EnableEvents = True
Else

For Each cht In ActiveSheet.ChartObjects

For Each myseries In cht.Chart.SeriesCollection

s = Split(myseries.Formula, ",")(2)
vntValues = myseries.Values
For i = 1 To UBound(vntValues)

Sheet19.Activate
Range("C2").Activate ' First Cell of CF - REF http://answers.microsoft.com/en-us/office/forum/office_2007-excel/testing-if-a-cell-or-range-of-cells-is/b05a6016-df7f-426a-b8b4-9a43b30bc95b?page=2&msgId=4d194dd2-1dec-4234-bd06-e44b87474a04
curColor = CFColorindex(Sheet19.Range(s).Cells(i)) ' XLD Routine
Debug.Print "curColor:" & curColor
myseries.Points(i).Interior.ColorIndex = curColor
Next i
Next myseries
Next cht
End If

Debug.Print "Time taken:" & DateDiff("s", start, Now()) & "s"
End Sub

[Onetrack]

the variable "s" holds 'Chart Data'!$C$2:$C$12

Ideally rather than "sheet19.activate" and "Range("C2").activate" the sheet and range to activate could be extracted from "s" above... The routine would then be complete!

[Andy Pope]

This should work for most cases, although probably not if the chart is linked to data outside the workbook.



s = Split(myseries.Formula, ",")(2)
Set shtData = ActiveChart.Parent.Worksheets(Replace(Split(s, "!")(0), "'", ""))
shtData.Activate
shtData.Range(s).Cells(1, 1).Activate

[Onetrack]

XLD/Andy - Please excuse my period of irrational exuberance...

YeeeHaa!!!!

SOLVED! And thank you both.