Conditionally Coloring a Graph in Excel - vba

Question

Hi there!
I am trying to color a graph (a task tracker) via VBA, in excel. The idea is to color all "categories" a certain color -- visually, it would mean making all bars on each "row" a particular color. I'm using the following code, which I copied from http://peltiertech.com/vba-conditional-formatting-of-charts-by-category-label/:
Sub ColorByCategoryLabel()
Dim rPatterns As Range
Dim iCategory As Long
Dim vCategories As Variant
Dim rCategory As Range
Set rPatterns = ActiveSheet.Range("A1:A5")
With ActiveChart.SeriesCollection(2)
vCategories = .XValues
For iCategory = 1 To UBound(vCategories)
Set rCategory = rPatterns.Find(What:=vCategories(iCategory))
.Points(iCategory).Format.Fill.ForeColor.RGB = rCategory.Interior.Color
Next
End With
End Sub
and I can't figure out what is wrong.
Basically, I have a series (series2), with horizontal (category) axis labels consisting of integers from 1-5. This category determines the vertical position of the bar, but I also want to color each bar in this series according to this vertical position, according to the color in the range(a1:a5) -- which is exactly what this code seems to be doing.
Any suggestions, as to the code, or perhaps, any alternative way to color bar graphs based on the value of the "horizontal (category) axis"?
Thanks!

Answer 1

Well, I found an answer to my problem by stepping through it. I can't imagine this to be the easiest way to horizontal bar graphs according to their height but it works.
Sub ColorByCategoryLabel()
Dim iCategory As Long
Dim vCategories As Variant
Dim rCategory As Range
Dim CurColor As Double
Dim CurColorIndex As Long
Dim CurHeight As Double
CurHeight = 0
CurColorIndex = 1
CurColor = ActiveSheet.Cells(CurColorIndex + 1, 10).Interior.Color
ActiveSheet.ChartObjects("Chart 1").Select
With ActiveChart.SeriesCollection(2)
vCategories = .XValues
For iCategory = 1 To UBound(vCategories)
If .Points(iCategory).Top > CurHeight Then
CurColorIndex = CurColorIndex + 1
CurColor = ActiveSheet.Cells(CurColorIndex + 1, 10).Interior.Color
CurHeight = .Points(iCategory).Top
End If
.Points(iCategory).Format.Fill.ForeColor.RGB = CurColor
Next
End With
End Sub
You would need to modify the line
Curcolor = ActiveSheet.Cells(CurColorIndex+1,10).Interior.Color
To properly specify the cells whose background color you wish to copy.
By the way, if anyone is interested in the timetracker, it is hosted here: https://drive.google.com/file/d/0B85fvjQDbl3lUVpPNmdGT1VkWW8/view?usp=sharing