Excel 2010 Charts - Change a specific bars colour based on its label value

[DAmoss]

Hi,

Can anyone help me achieve the following? I want to be able to alter the fill colour of a specific bar (say to Red) depending on the label name which I want to choose from a from a dropdown list.

eg. I have a list of wards which have population values attached and are shown in a bar chart accordingly (all coloured Blue)... I want to pick a particular ward from a dropdown list and that particular bar changes to red ... if that makes sense?

I've found this vba snippet (see below) but I can't get it to work for just one particular chart, the dropdown bar value that I want to change is picked up from cell reference B2:B2 (dropdown list) by the way.

Any help you can give would be much appreciated ... Don


Sub LoopThroughCharts()

Dim sht As Worksheet
Dim CurrentSheet As Worksheet
Dim cht As ChartObject

Application.ScreenUpdating = False
Application.EnableEvents = False

Set CurrentSheet = ActiveSheet

For Each sht In ActiveWorkbook.Worksheets
For Each cht In sht.ChartObjects
cht.Activate

'Do something with the chart...

Next cht
Next sht

CurrentSheet.Activate
Application.EnableEvents = True

End Sub

 

[SkipVought]

Hi,

Please supply
1) the chart source data table,
2) the type of chart,
3) the data range that is the source of the DropDown,
4) the data that is in that range.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DAmoss]

Hi,

Please see attached, the first sheet contains the list of wards and the colours I'm trying to pass to each data point, the dropdown above the ward list selects the ward bar that I want shown in red.

The other sheet contains the chart data and the bar chart itself, the selected ward is passed to B2 on this second sheet. The macro is attached to the chart and runs when I click on the chart.

I've added some other example code that I've found on the internet, but as yet I haven't been able to get it to work ie. pick up the ward colour and pass it to the appropriate data point bar ... hope that makes sense?

Thanks for taking a look at this.
Don

 

[SkipVought]

Here's your workbook back with several modifications.

On the Lookup Colours sheet, the Data Validation Drop Down cell has Range Name SelectedWard.

Next to it is a cell with a Range Name of SelectedWardPoint, with a formula to calculate the point value.

The sheet has a Change Event that fires the ColourChartBars procedure.

The ColourChartBars procedure has been modified to color the selected Ward column on the chart RED and all other columns your light blue. The major modification were made in this code block...

'
      With cht.Chart.SeriesCollection(1)
        For Each oPoint In .Points
            iPoint = iPoint + 1
            Select Case iPoint
                Case [SelectedWardPoint]
                    oPoint.Interior.Color = vbRed
                Case Else
                    oPoint.Interior.Color = 13995347
            End Select
        Next
      End With

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DAmoss]

Hi Skip,
Thanks, that works really well. I notice the colours are hard coded and not being picked up from the legend cells themselves, is it possible to pick up the cell colour and pass it to the chart bar or does it have to be fixed in the code?

I still have s slight problem, the code tries to alter all charts in the workbook (I tried it in another one I have), including ones I don't want to alter. How do I pass just the chart name to the colour bar code so that it only targets that particular chart. I have multiple similar charts on different sheets, but I only want to change certain ones if you see what I mean.

Hope that's OK to ask, and I appreciate your help so far, it works great in the example!

Cheers
Don

 

[SkipVought]

Thought of that last night.

'
  For Each sht In ActiveWorkbook.Worksheets
    For Each cht In sht.ChartObjects
      With cht.Chart.SeriesCollection(1)
        iPoint = 0
        For Each oPoint In .Points
            iPoint = iPoint + 1
            oPoint.Interior.Color = Range("ColourLegend")(iPoint).DisplayFormat.Interior.Color
        Next
      End With
    Next cht
  Next sht

regarding the single chart, replace the above code with...

'
      With [highlight #FCE94F]Worksheets("WardInfo").ChartObjects(1).[/highlight]Chart.SeriesCollection(1)
        iPoint = 0
        For Each oPoint In .Points
            iPoint = iPoint + 1
            oPoint.Interior.Color = Range("ColourLegend")(iPoint).DisplayFormat.Interior.Color
        Next
      End With

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DAmoss]

Hi Skip,
I did what you suggested above and replaced the code to make it work for a single chart, it works great, especially now as its picking up the legend cell colours now, it's so easy to undestand when you can see the actual code. But it's still not quite how I would like it to work.

I would like to be able to pass the target worksheet name and the target chart name to the sub-routine to make it totally flexible. That way I can call the sub-routine say 3 times from the wardlist sheet and alter three different charts on three different worksheets? Hard coding the worksheet name into the subroutine is not really how I envisaged it, unless I create three different copies of the same code and do it that way

Also, not sure about this, but does the ChartObjects or SeriesCollection reference number have to be changed as well if it's pointing to a different chart?

I think I need to invest in a good Excel VBA coding book, any suggestions?

Thanks for your help so far

 

[SkipVought]

I like John Walkenbach books for Excel & VBA.

So if you have variables for SheetName and ChartName...

'
      With Worksheets([b]SheetName[/b]).ChartObjects([b]ChartName[/b]).Chart.SeriesCollection(1)
        iPoint = 0
        For Each oPoint In .Points
            iPoint = iPoint + 1
            oPoint.Interior.Color = Range("ColourLegend")(iPoint).DisplayFormat.Interior.Color
        Next
      End With

...but the code assumes that SeriesCollection(1) is the Wards series. Is that true?

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DAmoss]

I've altered the subroutine as you've said above to take in the SheetName and ChartName ... see sub below, but now its not working :-(

I'm not sure if its SeriesCollection(1) for all, but my answer to the question is that all the charts I'm trying to change the colour bar for are pulling their data from the one data table, even if the charts are on different worksheets ... is that what you where asking?

I've attached the latest version ... I didn't think referencing Charts would be this hard ! Thank you for the JW book reference, I've just ordered his latest 'Power Programming with VBA' ... looks like a really good book to learn from.



Sub ColourChartBars(vSheetName As String, vChartName As String)
Dim oPoint As Point
Dim iPoint As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False

With Worksheets(vSheetName).ChartObjects(vChartName).Chart.SeriesCollection(1)
iPoint = 0
For Each oPoint In .Points
iPoint = iPoint + 1
oPoint.Interior.Color = Range("ColourLegend")(iPoint).DisplayFormat.Interior.Color
Next
End With

Application.EnableEvents = True

End Sub

The main calling routine now looks like this ... hope this is right

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [SelectedWard]) Is Nothing Then

Call ColourChartBars("WardLookup", "Chart1")
Call ColourChartBars("WardInfo", "Chart2")
Call ColourChartBars("WardInfo", "Chart3")

End If

End Sub

 

[SkipVought]

Your first sheet TAB has a trailing SPACE!!!

You need to look from my FAQ regarding using the Watch Window for debugging. I found your error immediately!

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DAmoss]

Hi Skip, apologies I should have noticed the trailing space and stepped through with a watch on the variables, my bad!

Regardless the routine does work beautifully now and only changes the bar in charts that I choose.

Just one final little question, can you give me a quick explanation on the INTERSECT command that you used and how it is actually working in my particular case, never seen this command and its use before? I've had a look at the online VBA reference, but I think a more 'useful' explanation would be better for me from your own knowledge.

Thanks for all your help and for being so patient.

Regards
Don

 

[SkipVought]

INTERSECT returns the result of the overlap/intersection of two or more ranges. If there is an intersection of all the ranges, the range of that intersection is returned. Otherwise Nothing is returned, (Nothing in this case is something, a value, rather than not anything). Consequently as it is used in this case...

If Not Intersect(expression) Is Nothing Then

Also, you wouldn't say that a range EQUALS something. Hence a range is nothing or it is not.

Hope that helps.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DAmoss]

Hi,

Unfortunately my solution only works for charts where the .XValue labels are in the same order as my ColourLegend lookup table!

If I sort the chart data (say by rank), then the chart labels and the colour lookup list are out of sink! So this brings me back to square one unfortunately.

So how can I get my routine to lookup the matching Data Point label value which matches the ward value that I pass to the subroutine, in order to change its bar particular colour?

Are the data labels attached to the actual data points and if so how do I specifically reference them?

Basically ... I need my routine to colour the bar via a matching data label, not the data point itself.

Cheers!

 

[SkipVought]

So loop through the chart source data, which is ranked/ordered as desired. Each Ward can then be looked up in the ColourLegend to get the Interior.Color.

Have a whack at that.

Or here's another approch: use Conditional formatting on the chart source data, referencing the data in the WardInfo sheet, (I'm doing this from memory, sheet where the ColourLegend table/Selections) reside. Then the DisplayFormat is right at hand for your code.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DAmoss]

Hi Skip,

It's ok I've managed to solve it myself by looking at some examples given on the Peltier Tech Blog and altering my code accordingly ...

Here's my revised version below, it could be shortened / tidied up even more, but I'm happy with as it as a working subroutine. The only thing I'm going to add now is to be able to pass it the two required bar colours (primary bar colour and the highlight bar colour) ... rather than trying to read them in as before, although I now know how to do that as well

Thanks for all your help once again ... Don


Sub ChartBarColourViaCategoryLabel(vSheetName As String, vChartName As String, sTargetCategoryLabel As String)
Dim rPatterns As Range
Dim iCategory As Long
Dim vCategories As Variant
Dim rCategory As Range
Dim sTargetCat As String
Dim sLab As Variant

Application.ScreenUpdating = False
Application.EnableEvents = False
sTargetCat = sTargetCategoryLabel
Set rPatterns = Range("ColourLegend")

With Worksheets(vSheetName).ChartObjects(vChartName).Chart.SeriesCollection(1)
vCategories = .XValues

For iCategory = 1 To UBound(vCategories)
Set rCategory = rPatterns.Find(What:=vCategories(iCategory))

If rCategory = sTargetCat Then
.Points(iCategory).Interior.Color = vbRed
Else
.Points(iCategory).Interior.Color = vbBlue
End If

Next iCategory
End With

Application.EnableEvents = True

End Sub