Multiple colors in one stacked bar

  • Thread starter Thread starter Radoslaw Krzyzan
  • Start date Start date
R

Radoslaw Krzyzan

I have to create the stacked bar chart based on following data :

Bar# Width Kind
1 50 1
80 2
110 4
150 2
199 1
2 70 4
90 1
150 2
223 3
450 4
3 30 1
50 3
67 4
90 1
110 2
150 3
190 2
250 1



I need three bars, the "kind" column determine the colour of one section in
current bar and the width determine width of this section. How to do it ?
Maybe I have to reformat data ?

--

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Radoslaw Krzyzan , pl.communicator@radek
http://www.communicator.pl
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Bar# Width Kind
1 50 1
80 2
110 4
150 2
199 1
2 70 4
90 1
150 2
223 3
450 4
3 30 1
50 3
67 4
90 1
110 2
150 3
190 2
250 1



--

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Radoslaw Krzyzan , pl.communicator@radek
http://www.communicator.pl
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Radoslaw -

This one was fun. I first rearranged the data:

value 1 value 2 value 3 color 1 color 2 color 3
50 70 30 1 4 1
80 90 50 2 1 3
110 150 67 4 2 4
150 223 90 2 3 1
199 450 110 1 4 2
150 3
190 2
250 1

I made the stacked bar chart from the first 3 columns, with series in
rows. Then I made a table elsewhere in the worksheet:

1
2
3
4

and I filled each of these cells with the color represented by that
number in the main table above (I colored cell 1 red, cell 2 yellow, etc.).

Then I ran the following macro. It makes sure a chart is selected, asks
the user to select the range with color numbers for each series and
point, then to select the range with the colored cells and number codes.
Then it loops through the first range, finds the number for each point,
then finds the corresponding color in the second range and colors the
bar. The code can be made to run faster for charts with more series with
more points, and you can always add more error trapping.

Sub ColorBars()
Dim rColor As Range
Dim rTable As Range
Dim iColor As Integer
Dim I As Integer
Dim J As Integer
Dim PtIJ As Point

If ActiveChart Is Nothing Then
MsgBox "Select a chart and try again", vbExclamation + vbOKOnly
Else
Set rColor = Application.InputBox _
(Prompt:="Select the range with series " & _
"and point color information", _
Title:="Select Color Input Range", Type:=8)
' returns a range
Set rTable = Application.InputBox _
(Prompt:="Select the colored range with " & _
"table of color numbers", _
Title:="Select Color Table", Type:=8)
' returns a range
With ActiveChart
I = .SeriesCollection.Count
If I = rColor.Rows.Count Then
' series by row
For I = 1 To .SeriesCollection.Count
For J = 1 To .SeriesCollection(I).Points.Count
.SeriesCollection(I).Points(J) _
.Interior.ColorIndex = _
rTable.Cells(rColor.Cells(I, J)) _
.Interior.ColorIndex
Next
Next
ElseIf I = rColor.Columns.Count Then
' series by column
For I = 1 To .SeriesCollection.Count
For J = 1 To .SeriesCollection(I).Points.Count
.SeriesCollection(I).Points(J) _
.Interior.ColorIndex = _
rTable.Cells(rColor.Cells(J, I)) _
.Interior.ColorIndex
Next
Next
End If
End With
End If
End Sub


- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______
 
Back
Top