VBA color changer on bar chart-- can you help fix my code

[tdmarcant]

My code is below and does not work very well or I don't know what I am doing.

I have a mid size table of about 200 rows delineated with start date-end date- service area.
Each service area is color coded , when the service area changes the color changes. I don't have any conditional formatting doing this I just picked a random fill color.

What this code does is pick the color of the 1st cell and applies it to every bar in my range I picked to create my bar chart so if the 1st cell is pink every bar in the chart is pink.
I need it to look at the cell range by color and name. It needs to pick color based on the value of the cell.

So if I picked 200 rows in the range it is all pink , the only way I work around this is I pick the ranges and create them individually by color it's the only way the chart displayed pink, blue yellow , green etc.

Does this makes any sense?



Sub CellColorsToChart()
Dim oChart As ChartObject
Dim MySeries As Series
Dim FormulaSplit As Variant
Dim SourceRange As Range
Dim SourceRangeColor As Long


'Loop through all charts in the active sheet
For Each oChart In ActiveSheet.ChartObjects


'Loop through all series in the target chart
For Each MySeries In oChart.Chart.SeriesCollection

'Get Source Data Range for the target series
FormulaSplit = Split(MySeries.Formula, ",")

'Capture the first cell in the source range then trap the color
Set SourceRange = Range(FormulaSplit(2)).Item(1)
SourceRangeColor = SourceRange.Interior.Color


On Error Resume Next
'Coloring for Excel 2003
MySeries.Interior.Color = SourceRangeColor
MySeries.Border.Color = SourceRangeColor
MySeries.MarkerBackgroundColorIndex = SourceRangeColor
MySeries.MarkerForegroundColorIndex = SourceRangeColor

'Coloring for Excel 2007 and 2010
MySeries.MarkerBackgroundColor = SourceRangeColor
MySeries.MarkerForegroundColor = SourceRangeColor
MySeries.Format.Line.ForeColor.RGB = SourceRangeColor
MySeries.Format.Line.BackColor.RGB = SourceRangeColor
MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor
MySeries.Format.Line.ForeColor.RGB = SourceRangeColor

Next MySeries
Next oChart


End Sub

 

[Worf]

See if this example helps. Note that my series formula has the following structure:

=SÉRIE(;;Bars!$E$110:$E$117;4)

Sub Tdmarcant()
Dim fs, ser As Series, co As ChartObject, c&
Set co = Sheets("Bars").ChartObjects("Chart6")          ' the chart
For Each ser In co.Chart.SeriesCollection
    fs = Split(ser.Formula, ":")
    c = Range(Split(fs(0), "!")(1)).Interior.Color      ' get cell color
    ser.Format.Fill.ForeColor.RGB = RGB(c Mod 256, c \ 256 Mod 256, c \ 65536 Mod 256)
Next
End Sub

 

[tdmarcant]

( I don't understand your code, are you hard coding the range?) ( What does the 4 mean?) I have a chart that grows and shrinks as the data chganges it can 2 bars or 200 bars and each bar can be a different color.

( Are you setting the chart as chart 6? I only have one chart)

 

[tdmarcant]

Set co = Sheets("Bars").ChartObjects("Chart1") ' the chart

it does not like this code or I do not now where to put it.

 

[Worf]

' standard module
Sub Tdmarcant()
Dim fs, ser As series, co As ChartObject, c&
Set co = Sheets("Bars").ChartObjects("Chart2")          ' the chart
For Each ser In co.Chart.SeriesCollection
    fs = Split(ser.Formula, ":")
    c = Range(Split(fs(0), "!")(1)).Interior.Color      ' get cell color
    ser.Format.Fill.ForeColor.RGB = RGB(c Mod 256, c \ 256 Mod 256, c \ 65536 Mod 256)
Next
End Sub

- The image above shows the data layout I’m using for testing. Note the series formulae.
- The code is not hard coding ranges; it parses the formula to extract it. If the chart is dynamic, the formula will automatically adjust.
- That number 4 means it’s the fourth series on the chart. How many series do you have? Can you post a link to your workbook?
- You have to replace the sheet and chart names with yours. Note that “Chart 1” is different from “Chart1”. What error message pops up?

 

[tdmarcant]

vba run time error 2147024809 the item with the specified name wasn't found is the error


https://docs.google.com/<wbr>spreadsheets/d/<wbr>1cNNCu9yYaWGgY7THeSPvvEnIlTMoL<wbr>ae30yogKgTafJo/edit#gid=<wbr>1549928507 here is a link to google docs

 

[Worf]

Is this it?

Sub ColorBars()
Dim co As ChartObject, ser As Series, xv, r As Range, i%, v
Set co = Sheets("Task Details").ChartObjects("Chart 1")
Set ser = co.Chart.SeriesCollection(1)
xv = ser.XValues
Set r = Sheets("Task Details").[a200]
For i = 1 To 12
    r.Offset(i, 1) = r.Offset(i).Interior.Color             ' populate color codes at column B
Next
For i = 1 To ser.Points.Count
    v = WorksheetFunction.VLookup(xv(i), Range("a201:b212"), 2, 0)              ' get color code
    ser.Points(i).Format.Fill.ForeColor.RGB = RGB(v Mod 256, v \ 256 Mod 256, v \ 65536 Mod 256)
Next
End Sub

 

[tdmarcant]

WOW I really appreciate your help I will give it a whirl. I really apprciate the help I won't bug you anymore.

I will definitely pay it forward and wish you good karma.

Sub ColorBars()
Dim co As ChartObject, ser As Series, xv, r As Range, i%, v
Set co = Sheets("Task Details").ChartObjects("Chart 1")
Set ser = co.Chart.SeriesCollection(1)
xv = ser.XValues
Set r = Sheets("Task Details").[a200]
For i = 1 To 12
    r.Offset(i, 1) = r.Offset(i).Interior.Color             ' populate color codes at column B
Next
For i = 1 To ser.Points.Count
    v = WorksheetFunction.VLookup(xv(i), Range("a201:b212"), 2, 0)              ' get color code
    ser.Points(i).Format.Fill.ForeColor.RGB = RGB(v Mod 256, v \ 256 Mod 256, v \ 65536 Mod 256)
Next
End Sub

[/QUOTE]

 

[tdmarcant]

could you send me your vlookup function. mine wont pick this up.

 

[Worf]

Below is a link to my test workbook. Note that the categories at column A must be an exact match to the horizontal axis labels, including trailing spaces if any.
You can trim everything to avoid space problems.

https://dl.dropboxusercontent.com/u/52116836/Roadmap2.xlsm