A user of my Peltier Tech Charts for Excel 3.0 asked recently whether this program could perform interactive formatting of all series 2 in a set of charts to the same color.
Well, my program does many things, but it can’t do this. Such a highly specific feature is hard to support in a general purpose program. Next, someone will want to change all series 1 or series 3 or series named “Values”, or they’ll want a different color. It’s difficult to program for all of the various possibilities. (We can try, as I’ll show later.)
But if you need something particular like this, it’s not hard to spin your own VBA code.
Simple Code for Interactive Formatting
For my user’s request, it was as simple as filling a cell (say, H5) with a certain color, then changing the lines for each “Series2” in his charts to this color. The code looks like this:
Sub ColorSeries2LikeCellH5()
Dim iColor As Long
Dim shp As Shape
Dim chob As ChartObject
' get the color
iColor = ActiveSheet.Range("H5").Interior.Color
If Not ActiveChart Is Nothing Then
' active chart (one chart selected)
ActiveChart.SeriesCollection(2).Format.Line.ForeColor.RGB = iColor
ElseIf TypeName(Selection) = "DrawingObjects" Then
' multiple charts selected
For Each shp In Selection.ShapeRange
If shp.HasChart Then
shp.Chart.SeriesCollection(2).Format.Line.ForeColor.RGB = iColor
End If
Next
Else
' no chart selected so do all charts
For Each chob In ActiveSheet.ChartObjects
chob.Chart.SeriesCollection(2).Format.Line.ForeColor.RGB = iColor
Next
End If
End SubWhich Chart to Format?
Let’s look a little closer at one piece of this code, which determines whether to work on one chart (the active chart), multiple selected charts (selected using Ctrl+Click or Shift+Click), or all charts on the active sheet (if no chart was selected). I’ve color-coded the explanations and the code sections.
If one chart is selected, then there is an active chart. The strange line of code “If Not ActiveChart Is Nothing Then” really means “If ActiveChart Is Something Then“, so we should process the active chart.
If multiple charts are selected, the selection consists of a collection called “DrawingObjects“, so we should process each shape in this collection (which is also a “ShapeRange“), provided that shape contains a chart.
Finally, if neither of these conditions are met (that is, no chart is selected), we’ll process each chart object on the active sheet. If there are no chart objects, the code will just finish up.
If Not ActiveChart Is Nothing Then
' active chart (one chart selected)
' --> Process active chart
ElseIf TypeName(Selection) = "DrawingObjects" Then
' multiple charts selected
For Each shp In Selection.ShapeRange
If shp.HasChart Then
' --> Process each selected shape that contains a chart
End If
Next
Else
' no chart selected so do all charts
For Each chob In ActiveSheet.ChartObjects
' --> Process each chart object on the active sheet
Next
End IfHow do I know all of this stuff? Well, I’ve been around for a long time, and I’ve swiped code from a lot of experts.
The code above is pretty good, but it’s not very flexible. If you need to get the color from a different cell, you need to edit the command that references cell H5. You need similar changes if you need to format a different series. This is fine if it’s your own code, but not if the user is your colleague who isn’t VBA-savvy.
Better, Flexible Interactive Formatting Code
So let’s add a couple mini-dialogs to ask the user what we should do. This makes it truly interactive formatting.
Which Cell Has the Desired Color?
First we’ll use Application.InputBox to ask the user which cell is filled with the color we want to use.
On Error Resume Next
Set rng = Application.InputBox("Select a cell filled with the desired line color", _
"Select a Colored Cell", , , , , , 8)
If rng Is Nothing Then GoTo ExitSub
On Error GoTo 0
iColor = rng.Interior.ColorThis pops up the following dialog:
The 8 as the last argument for InputBox tells VBA to expect the user to supply a range.
We use “On Error Resume Next” because if the user cancels the InputBox, “Set rng =” will return an error. Bypassing the error, if the user cancels, rng will not be defined, so we will branch to ExitSub, a label at the end of the procedure.
If the user selects a cell with not fill color applied, the color white will be applied to the applicable series. This probably isn’t what you want, but at least the code doesn’t produce any ugly run-time errors.
Which Series Should We Change?
Next, we’ll use Application.InputBox to ask the user which series to change.
vSrs = Application.InputBox("Enter the series number or name to be changed", _
"Identify Series", , , , , , 3)
If TypeName(vSrs) = "Boolean" Then GoTo ExitSubThis produces another dialog:
Using 1 as the last argument for InputBox tells VBA to expect a number, while using 2 tells VBA it’s text; we’ve used 3, which means number or text (3 = 1 + 2).
If the user cancels, what is returned is the Boolean value False (not the text value “False”). So we test for a Boolean, and if we get one, we branch to the ExitSub label as above.
If the number or name entered by the user does not correspond to an existing series in the chart, an ugly run-time error occurs. It’s a little more complicated to bypass the error, but your users deserve the best.
The error is handled by modifying a line of code like this:
ActiveChart.SeriesCollection([series number or name]).Format.Line.ForeColor.RGB = iColor
First, at the top of the procedure, declare a new object variable to represent the series being sought
Dim oSrs As Series
Then you need to prevent Excel from halting at the error when it finds no matching series, and turn error behavior back on, assign the object variable to the desired series, and if this assignment works (remember, “If Not oSrs Is Nothing” means “If oSrs is Something“), format the series:
On Error Resume Next
Set oSrs = ActiveChart.SeriesCollection(vSrs)
On Error GoTo 0
If Not oSrs Is Nothing Then
oSrs.Format.Line.ForeColor.RGB = iColor
End IfThe Improved Routine
So here’s the new and improved routine:
Sub ColorSeriesLikeCell()
Dim rng As Range
Dim vSrs As Variant
Dim iColor As Long
Dim shp As Shape
Dim chob As ChartObject
Dim oSrs As Series
' get cell filled with desired color
On Error Resume Next
Set rng = Application.InputBox("Select a cell filled with the desired line color", _
"Select a Colored Cell", , , , , , 8)
If rng Is Nothing Then GoTo ExitSub
On Error GoTo 0
iColor = rng.Interior.Color
' identify the series
vSrs = Application.InputBox("Enter the series number or name to be changed", _
"Identify Series", , , , , , 3)
If TypeName(vSrs) = "Boolean" Then GoTo ExitSub
If Not ActiveChart Is Nothing Then
' active chart (one chart selected)
On Error Resume Next
Set oSrs = ActiveChart.SeriesCollection(vSrs)
On Error GoTo 0
If Not oSrs Is Nothing Then
oSrs.Format.Line.ForeColor.RGB = iColor
End If
ElseIf TypeName(Selection) = "DrawingObjects" Then
' multiple charts selected
For Each shp In Selection.ShapeRange
If shp.HasChart Then
Set oSrs = Nothing
On Error Resume Next
Set oSrs = shp.Chart.SeriesCollection(vSrs)
On Error GoTo 0
If Not oSrs Is Nothing Then
oSrs.Format.Line.ForeColor.RGB = iColor
End If
End If
Next
Else
' no chart selected so do all charts
For Each chob In ActiveSheet.ChartObjects
Set oSrs = Nothing
On Error Resume Next
Set oSrs = chob.Chart.SeriesCollection(vSrs)
On Error GoTo 0
If Not oSrs Is Nothing Then
oSrs.Format.Line.ForeColor.RGB = iColor
End If
Next
End If
ExitSub:
End SubWell, that’s pretty nifty. But what if I have something besides a line chart?
Best, Versatile Interactive Formatting Code
Now we’ll add the capability to check each series chart type, and use the appropriate formatting syntax to change the line color, the marker color, or the fill color. To keep from repeating a lot of this code for checking series chart type, I’ll introduce a function to call to change the series formatting. Using a function also means that if I need to change or enhance the feature, I only need to change it one time in the function, and not everywhere I use the feature.
What’s the Chart Type?
I’ll pass the series and the color into the function, and it will determine based on the series chart type. The function will have this form:
Function RecolorSeries(srs As Series, iClr As Long) As Boolean
' assume True unless otherwise
RecolorSeries = True
Select Case srs.ChartType
Case [Line] and [Scatter with Line Only]
' --> change line color
Case [Line with Markers] and [Scatter with Lines and Markers]
' --> change line color
' --> change marker color (foreground and maybe background)
Case [Scatter with Markers Only]
' --> change marker color (foreground and maybe background)
Case [Bar], [Column], and [Area]
' --> change fill color
Case Else
' did not reformat a series
RecolorSeries = False
End Select
End FunctionWe can call it like this (which is how I’ll call it)
RecolorSeries [series], [color]and it will run like a sub, or like
bDidItWork = RecolorSeries([series], [color])and it will still run like a sub, but then return the value True to bDidItWork if it formatted a series and False if it did not. You could then notify the user if one or more series were not changed because of their chart type.
Should We Fill the Marker?
We want to change the MarkerForegroundColor of any markers, but the MarkerBackgroundColor only if it is reasonable to fill the marker. For the Plus, X, and Star markers, filling the marker results in a big ugly square marker where the Plus, X, or Star foreground is not distinguished from the background. We could probably get more creative based on whether the existing background color matches the foreground, but this is just a blog post, eh?
So anyway, after we do the MarkerForegroundColor, we test for the marker style:
Select Case srs.MarkerStyle
Case xlMarkerStylePlus, xlMarkerStyleStar, xlMarkerStyleX
' fill should not be changed
Case Else
' --> change the fill
End SelectThe Reformatting Function
All fixed up the function looks like this:
Function RecolorSeries(srs As Series, iClr As Long) As Boolean
' assume True unless otherwise
RecolorSeries = True
Select Case srs.ChartType
Case xlLine, xlLineStacked, xlLineStacked100, _
xlXYScatterLinesNoMarkers, xlXYScatterSmoothNoMarkers
' change line color
srs.Format.Line.ForeColor.RGB = iClr
Case xlLineMarkers, xlLineMarkersStacked, xlLineMarkersStacked100, _
xlXYScatterLines, xlXYScatterSmooth
' change line color and marker color
srs.Format.Line.ForeColor.RGB = iClr
srs.MarkerForegroundColor = iClr
Select Case srs.MarkerStyle
Case xlMarkerStylePlus, xlMarkerStyleStar, xlMarkerStyleX
' fill should not be changed
Case Else
srs.MarkerBackgroundColor = iClr
End Select
Case xlXYScatter
' change marker color
srs.MarkerForegroundColor = iClr
Select Case srs.MarkerStyle
Case xlMarkerStylePlus, xlMarkerStyleStar, xlMarkerStyleX
' fill should not be changed
Case Else
srs.MarkerBackgroundColor = iClr
End Select
Case xlBarClustered, xlBarStacked, xlBarStacked100, _
xlColumnClustered, xlColumnStacked, xlColumnStacked100, _
xlArea, xlAreaStacked, xlAreaStacked100
' change fill color
srs.Format.Fill.ForeColor.RGB = iClr
Case Else
' did not reformat a series
RecolorSeries = False
End Select
End FunctionThe Finished Main Routine
The main routine now looks like this, and it works in conjunction with the function above:
Sub RecolorSeriesLikeCell()
Dim rng As Range
Dim vSrs As Variant
Dim iColor As Long
Dim shp As Shape
Dim chob As ChartObject
Dim oSrs As Series
' get cell filled with desired color
On Error Resume Next
Set rng = Application.InputBox("Select a cell filled with the desired color", _
"Select a Colored Cell", , , , , , 8)
If rng Is Nothing Then GoTo ExitSub
On Error GoTo 0
iColor = rng.Interior.Color
' identify the series
vSrs = Application.InputBox("Enter the series number or name to be changed", _
"Identify Series", , , , , , 3)
If TypeName(vSrs) = "Boolean" Then GoTo ExitSub
If Not ActiveChart Is Nothing Then
' active chart (one chart selected)
On Error Resume Next
Set oSrs = ActiveChart.SeriesCollection(vSrs)
On Error GoTo 0
If Not oSrs Is Nothing Then
RecolorSeries oSrs, iColor
End If
ElseIf TypeName(Selection) = "DrawingObjects" Then
' multiple charts selected
For Each shp In Selection.ShapeRange
If shp.HasChart Then
Set oSrs = Nothing
On Error Resume Next
Set oSrs = shp.Chart.SeriesCollection(vSrs)
On Error GoTo 0
If Not oSrs Is Nothing Then
RecolorSeries oSrs, iColor
End If
End If
Next
Else
' no chart selected so do all charts
For Each chob In ActiveSheet.ChartObjects
Set oSrs = Nothing
On Error Resume Next
Set oSrs = chob.Chart.SeriesCollection(vSrs)
On Error GoTo 0
If Not oSrs Is Nothing Then
RecolorSeries oSrs, iColor
End If
Next
End If
ExitSub:
End Sub
