CODEWITHSUNDEEP
vbaexcel
q335r49
q335r49

Reputation: 648

Conditionally Coloring a Graph in Excel

Coloring a graph via value

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!

Upvotes: 0

Views: 275

Answers (1)

q335r49
q335r49

Reputation: 648

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

Upvotes: 1

Related Questions