Conditional Chart

TrippyTom

Well-known Member
Joined
Nov 16, 2004
Messages
587
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.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

will_simpson

New Member
Joined
Oct 17, 2006
Messages
29
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

Well-known Member
Joined
Nov 16, 2004
Messages
587
Thanks Will! That works great. :biggrin:

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

New Member
Joined
Oct 17, 2006
Messages
29
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

Well-known Member
Joined
Nov 16, 2004
Messages
587

ADVERTISEMENT

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:
Code:
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
Code:
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

Well-known Member
Joined
Nov 16, 2004
Messages
587
er... nevermind.
I'm dumb.

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

will_simpson

New Member
Joined
Oct 17, 2006
Messages
29
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
 

Forum statistics

Threads
1,136,597
Messages
5,676,719
Members
419,647
Latest member
usas12gthr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top