Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.charting
external usenet poster
 
Posts: 120
Default Coloring individual points/bars

As there have been several questions piled up on the coloring individual
points within a single series, let me offer a solution that I have been using
for more then seven years. It proved in the analysis of data, especially then
in the connection with next two subs that link color with the flag of
relevancy for statistical treatment. Sub naturally loose sense for linear
markers (+ × _ - ); for using in such a field it would need small adaptation.
It is developed and verified for xl2003, I have never tried to adapt for
2007.


Sub MarkerColor()

'Sub changes the colors of individual area markers in the selected series
'of x-y chart into the colors of the fonts of parent cell values (y).
'It keeps the marker interior the way as defined for the whole series:
'either empty, or of uniform color. If, however, the background
'of any value cell is light gray, the interior of corresponding
'marker changes into its opposite, i.e. if the series has been declared
'as marker full then such a marker turns to empty and vice versa.
'If the y-cell background is medium gray, the marker disappears.
'The aim is to identify individual markers or their groups within
'one complete series on a x-y or bar chart without having to decompose
'the parent range into subranges.

Dim SP As Points, W As Range
Dim ErrMsg As String, SPF As String, Rng As String
Dim I As Long, N As Long, PosComma As Long, ICI As Long, FCI As Long
Dim MarkerIsEmpty As Boolean, ChT As Long, ChType As String

Const LightGray = 15, MediumGray = 48

ErrMsg = "No series has been selected"
On Error GoTo ErrExit
ChT = Selection.ChartType
Select Case ChT
Case xlXYScatter, xlXYScatterLines, xlXYScatterLinesNoMarkers,
xlXYScatterSmooth, _
xlXYScatterSmoothNoMarkers
ChType = "XY"
Case 51 To 59
ChType = "Column"
Case Else
ErrMsg = "This chart cannot be adapted in this way": GoTo ErrExit
End Select
Set SP = Selection.Points
N = SP.Count
SPF = SP.Parent.Formula
I = 3
Do
I = I + 1
Rng = Right(SPF, I)
Loop Until Left(Rng, 1) = "!"
Rng = Right(Rng, Len(Rng) - 1)
PosComma = Application.WorksheetFunction.Search(",", Rng)
Rng = Left(Rng, PosComma - 1)
Set W = Range(Rng)
Application.ScreenUpdating = False
If ChType = "XY" Then
MarkerIsEmpty = Selection.MarkerBackgroundColorIndex = xlNone
For I = 1 To N
FCI = W.Cells(I).Font.ColorIndex
On Error GoTo Skip
SP(I).MarkerForegroundColorIndex = FCI
ICI = W.Cells(I).Interior.ColorIndex
If ICI = LightGray Then
If MarkerIsEmpty Then
SP(I).MarkerBackgroundColorIndex = FCI
Else
SP(I).MarkerBackgroundColorIndex = xlNone
End If
ElseIf ICI = MediumGray Then
SP(I).MarkerForegroundColorIndex = xlNone
SP(I).MarkerBackgroundColorIndex = xlNone
Else
If Not MarkerIsEmpty Then
SP(I).MarkerBackgroundColorIndex = FCI
Else
SP(I).MarkerBackgroundColorIndex = xlNone
End If
End If
Skip:
Resume Next
Next I
ElseIf ChType = "Column" Then
For I = 1 To N
FCI = W.Cells(I).Font.ColorIndex
SP(I).Interior.ColorIndex = FCI
Next I
End If
Application.ScreenUpdating = True
Exit Sub
ErrExit:
MsgBox ErrMsg
On Error GoTo 0
End Sub

--
Petr Bezucha
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Customise error bars on individual bars in a bar chart 2007 Millie Charts and Charting in Excel 2 April 25th 09 04:16 AM
How do I specify min/max error bars for individual data points? jvitters Charts and Charting in Excel 1 June 11th 07 04:28 PM
excel should let you vary error bars for individual points CRC Charts and Charting in Excel 4 July 5th 06 11:52 AM
Calculate and display individual error bars for individual points del Charts and Charting in Excel 2 March 31st 06 05:11 PM
Calculate and display individual error bars for individual points del Charts and Charting in Excel 1 March 31st 06 04:24 AM


All times are GMT +1. The time now is 01:00 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"