colouring pivotchart bars using code

  • Thread starter Thread starter neowok
  • Start date Start date
N

neowok

I have the floowing pivotchart (see attached)

what I want to do is colour these bars based on the catagory at th
bottom using code. i.e. if catagory is Comms & SCADA then colour it x
colour.

now sometimes there is 6 catagories, sometimes 7 (but never more tha
7) so what i need also, is to put that code inside a loop which say
something like for column 1 to last, if the catagory for this column
"comms & SCADA" then colour it xx colour.

ive got as far as colour the bar using this code for each

ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
ActiveChart.SeriesCollection(1).Points(1).ApplyDataLabel
ShowValue:=True
With Selection.Interior
.ColorIndex = 33
End With

however the catagories are not always in the same order (and ther
arent always the same number) so at the moment im having to manuall
add the code and colours for each of the bars. what i want to do i
have code that will colour the bars in based on what the delivery grou
is. there are 7 set groups which will not change and as you can se
from the graph, this weekthere is only 6 listed.

basically i need the code which says
from <first bar> to <last bar> do
if bar is for delivery group "xxxx" then set colour to xx
if bar is for delivery group "yyyy" then set colour to yy
etc etc with one if for each of the 7 groups.

Thank

Attachment filename: pivot1.jpg
Download attachment: http://www.excelforum.com/attachment.php?postid=58060
 
First a quick note to speed up your program. Your first three lines are:

ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
ActiveChart.SeriesCollection(1).Points(1).ApplyDataLabels _
ShowValue:=True

You can skip the first two, because all they do is select objects, and
in general you do not need to select an object in VBA in order to change it.

An easy way to match up the category label to a color is to use the
Select Case construction:

Sub ColorPoints()
Dim iPtCt As Long
Dim iPtIdx As Long

With ActiveChart.SeriesCollection(1)
iPtCt = .Points.Count
For iPtIdx = 1 To iPtCt
Select Case WorksheetFunction.Index(.XValues, iPtIdx)
Case "A"
.Points(iPtIdx).Interior.ColorIndex = 1
Case "B"
.Points(iPtIdx).Interior.ColorIndex = 2
Case "C"
.Points(iPtIdx).Interior.ColorIndex = 3
Case "D"
.Points(iPtIdx).Interior.ColorIndex = 4
Case Else
.Points(iPtIdx).Interior.ColorIndex = 5
End Select
Next
End With
End Sub

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______
 
its not working, no idea why but its not picking up the cases at all,
heres the code i have

Dim iPtCt As Long
Dim iPtIdx As Long

With ActiveChart.SeriesCollection(1)
iPtCt = .Points.Count
For iPtIdx = 1 To iPtCt
Select Case WorksheetFunction.Index(.XValues, iPtIdx)
Case "SMEP Projects & Commissioning"
Points(iPtIdx).Interior.ColorIndex = 4
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case "Special Projects Infrastructure"
Points(iPtIdx).Interior.ColorIndex = 38
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case "Permanent Way & Track"
Points(iPtIdx).Interior.ColorIndex = 36
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case "Special Projects - Property"
Points(iPtIdx).Interior.ColorIndex = 35
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case "L&E, Structures & Depot"
Points(iPtIdx).Interior.ColorIndex = 34
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case "JNUP & 7th Car"
Points(iPtIdx).Interior.ColorIndex = 37
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case "Comms & SCADA"
Points(iPtIdx).Interior.ColorIndex = 39
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case Else
Points(iPtIdx).Interior.ColorIndex = 3
End Select
Next
End With

its basically colouring all the bars red, which is colourindex 3, which
is the 'else' at the bottom, even though all 7 of those cases are there
as far as i can see.

Ive also got this extra bit of code in another sub for another table
which has more than one series so i can add data labels to it all (but
dont need to change the bar colours) but it seems to take a couple of
seconds to run but it does work, is there any way to make it more
efficient? also can i add a different font colour to the 'data label'?
I can do it manually but not sure of the code for it.

Dim iPtCt As Long
Dim iPtIdx As Long
Dim iPtCt2 As Long
Dim iPtIdx2 As Long

iPtCt2 = ActiveChart.SeriesCollection.Count
For iPtIdx2 = 1 To iPtCt2
With ActiveChart.SeriesCollection(iPtIdx2)
iPtCt = .Points.Count
For iPtIdx = 1 To iPtCt
Points(iPtIdx).ApplyDataLabels ShowValue:=True
Next
End With
Next
End Sub

Thanks
 
1. I didn't know what was wrong, until I looked at your chart on Excel
Forum. Your XValues are actually comprised of the contents of two cells,
separated by a CR-LF character. You might try something like this (which
I haven't tested, sorry):

Select Case True
Case InStr(WorksheetFunction.Index(.XValues, iPtIdx), _
"SMEP Projects & Commissioning") > 0
.Points(iPtIdx).Interior.ColorIndex = 4
.Points(iPtIdx).ApplyDataLabels ShowValue:=True
Case InStr(WorksheetFunction.Index(.XValues, iPtIdx), _
"Special Projects Infrastructure") > 0
.Points(iPtIdx).Interior.ColorIndex = 38
.Points(iPtIdx).ApplyDataLabels ShowValue:=True

etc.

Use descriptive variables. iPtCt to me is an integer that counts the
points in the series, and iPtIdx is an index used to loop through the
points. I'd use iSrsCt for a count of the series collection, not iPtCt2.
Keep using the indentation, to make the code easier to read (for us
looking at your post, and yourself wondering next week what were you
thinking last week).

Also, you don't need to loop through every point if each gets the same
kind of label. Turn this:

With ActiveChart.SeriesCollection(iPtIdx2)
iPtCt = .Points.Count
For iPtIdx = 1 To iPtCt
.Points(iPtIdx).ApplyDataLabels ShowValue:=True
Next
End With

into this:

With ActiveChart.SeriesCollection(iPtIdx2)
.ApplyDataLabels ShowValue:=True
End With

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______
 
Thanks, just tried it but it doesnt seem to work, theres no errors but
it doesnt colour the line, the code I tried was

Dim iPtCt As Long
Dim iPtIdx As Long

With ActiveChart.SeriesCollection(1)
iPtCt = .Points.Count
For iPtIdx = 1 To iPtCt
Select Case True
Case InStr(WorksheetFunction.Index(.XValues, iPtIdx), _
"SMEP Projects & Commissioning") > 0
..Points(iPtIdx).Interior.ColorIndex = 4
..Points(iPtIdx).ApplyDataLabels ShowValue:=True
End Select
Next
End With

but it had no effect.

Theres no cr-lf characters in the names on the pivottable, but
obviously it has to wrap the names on the chart to make them fit so I
guess maybe its adding the cr-lf then? It doesnt seem to work anyway
unfortunately and I could really do with getting it to work because I
cant keep going in and colouring these bars all the time.

Anyone know anything else I can try?

Thanks
 
When you step through the code, do the lines under the Case statement
ever get highlighted?

If you send me the workbook, I could look at it for you. Or post it on
Excel Forum.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______
 
It highlights the case statement then skips to the next one withou
going to the code inside it so it thinks that case is not true.

I emailed you the workbook as its too big to let me post it here.

Thank
 
Back
Top