Conditional Chart

[TrippyTom]

I want to make a bar chart with 1 series, but have the fill color of the company change based on a separate set of values 1 - 5. (which I will have in the next column).

This is slightly different than the examples of conditional charting listed on Jon Peltier's site: http://peltiertech.com/Excel/Charts/ConditionalChart1.html

I was wondering if anyone has tried this, or knows how I would do it. I know I can do this manually but I wanted to search for a more automated way. If you think this would require VBA I'm willing to go that route as well.

 

[will_simpson]

This code assumes the columns are arranged

Company Name----Value----1-5Value----Colour Lookup

It also assumes the Column Headings are in row 1 and start in column A

The colour lookup is the VBA number of the colour you want, maybe use a lookup to populate this from whatever is in the 1-5Value column?

Create a bar chart manually in the sheet, in "Format Data Series" when you right click the data series, there'll be an Options tab, in there you can select to vary colour by point.

Once that's done this code will update the colours of the bars for you in Excel 2000 anyway.


Sub Change_chart()


Range("D2").Select

For x = 1 To 6

filler = ActiveCell.Value

ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Points(x).Select

With Selection.Interior
.ColorIndex = filler
End With

Sheets("Sheet1").Cells(x + 2, 4).Activate
Next x

End Sub



Change the "For 1 to 6" bit depending on how many companies you've got.

 

[TrippyTom]

Thanks Will! That works great.

Now I just have to figure out how to make the number of companies a variable for the loop to make it more flexible. I think if I'm in D2 and use CTRL + SHIFT + {Down Arrow} in vba and counted the number of rows that might work.

 

[will_simpson]

Tom, no problem, how about using the the ctrl down and then
x = Activecell.Row - 1

Of course you also need to work out how to create the graph from a dynamic range of companies, which shouldn't be too tricky if you record the macro to create the graph in the first place and then edit the code.

 

[TrippyTom]

Hey Will...

In my macro to make the chart, I named the chart "myChart"... and then I changed your macro to look for that chart, but it doesn't seem to be working. it gets to the line that says:
ActiveSheet.ChartObjects("myChart").Activate
and exits the sub

How do I fix this so it colors myChart right?

Here's my code so far:

Sub createMyChart()
'On Error GoTo myEnd
    Application.ScreenUpdating = False
    Charts.Add
    ActiveChart.Name = "myChart"
    MsgBox ActiveChart.Name
    ActiveChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:="Varied_Bar"
    
    'myChartRange is a Dynamic Range I setup so the chart will change dynamically if you add or remove companies
    ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("myChartRange"), PlotBy:=xlColumns
    
    ActiveChart.Location where:=xlLocationAsObject, Name:="Sheet1"
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.AutoScaleFont = False
    With Selection.TickLabels.Font
        .Name = "Arial"
        .Size = 8
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.Axes(xlCategory).Select
    Selection.TickLabels.AutoScaleFont = False
    With Selection.TickLabels.Font
        .Name = "Arial"
        .Size = 8
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .MaximumScaleIsAuto = True
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    Application.ScreenUpdating = True
    Call Change_chart
myEnd:
End Sub

Sub Change_chart()
Dim myFinalIteration As Integer
On Error GoTo myEnd
    ScreenUpdating = True
    Range("D2").End(xlDown).Select
    myLastLoop = Selection.Row - 1
    For x = 1 To myLastLoop 'Loops through all companies
        filler = ActiveCell.Value
        ActiveSheet.ChartObjects("myChart").Activate
        ActiveChart.SeriesCollection(1).Points(x).Select
        With Selection.Interior
            .ColorIndex = filler
        End With
        Sheets("Sheet1").Cells(x + 2, 4).Activate
    Next x
    ScreenUpdating = True
myEnd:
End Sub

 

[TrippyTom]

er... nevermind.
I'm dumb.

I changed it to this and it works great.
ActiveSheet.ChartObjects(1).Activate

 

[will_simpson]

Tom, just one thing, does the first column get the right colour?

Looking at the code, using xlDown, do you not get the colour of the last company in the first column?

Think you need to reset the activecell back to D2 after you've found the last mylastloop value?

Sub Change_chart()
Dim myFinalIteration As Integer
On Error GoTo myEnd
ScreenUpdating = True
Range("D2").End(xlDown).Select
myLastLoop = Selection.Row - 1
Range("D2").Select
For x = 1 To myLastLoop 'Loops through all companies
filler = ActiveCell.Value
ActiveSheet.ChartObjects("myChart").Activate
ActiveChart.SeriesCollection(1).Points(x).Select
With Selection.Interior
.ColorIndex = filler
End With
Sheets("Sheet1").Cells(x + 2, 4).Activate
Next x
ScreenUpdating = True
myEnd:
End Sub

 

[TrippyTom]

wow, good eye!
I didn't notice that.

THANKS!