One Range, Two Colors

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am wondering if there is a way to get Excel to loop through a series of
data, build a chart based on this series of data, and alternate the colors of
the bars on the chart. I guess the even points have to be a variable (i.e.,
Points(2).Select, Points(4).Select, etc.) This kind of a pain to do if
looking at only one series.


This is the macro that I recorded:
Sub Macro1()

ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With

With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With

With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(4).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False

With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(6).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With

With Selection.Interior
.ColorIndex = 11

End With
ActiveChart.SeriesCollection(1).Points(8).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With

With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(10).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With

With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(12).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With

With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(14).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With

End Sub

Finally, there may be a way for the user to select the series; I’m thinking
of something like the following (which I found on this DG)…

Dim myRange As Range
Dim myAdd As String

Set myRange = Range("A1")
myRange.Offset(0, 3) = ActiveSheet.Range("A1")
Set myRange = Application.InputBox( _
"Select Range to link from", Type:=8)

However, this doesn’t work for some reason…

Any guidance would be much appreciated.

Regards,
Ryan---
 
In answer to your first question, this macro will loop through a series (in
this case series #1) and alternate the colors based on the colorindex numbers
that you choose:

Sub AlternateSeriesColors()

Dim A As Integer
Dim B As Integer

A = 1
B = 2

Do

On Error GoTo ErrHandler:

ActiveChart.SeriesCollection(1).Points(A).Interior.ColorIndex = 4
ActiveChart.SeriesCollection(1).Points(B).Interior.ColorIndex = 7

A = A + 2
B = B + 2

Loop

ErrHandler: Exit Sub

End Sub
 
Build it as two series (stacked bars or columns), where one series has even
points and the other odd points. Format each series uniquely. No need for
macros.

- Jon
 
Sub AlternateBarColors
Dim iPt As Long
With ActiveChart.SeriesCollection(1)
For iPt = 1 To .Points.Count
Select Case iPt Mod 2
Case 0
.ColorIndex = 7
Case 1
.ColorIndex = 4
End Select
Next
End With
End Sub


- Jon
 
Brilliant!!! Worked great John! The final version is listed below (maybe
others can find some value added in this Sub too). Jon, thanks for
responding; yours is great too...I just ended up going with John’s
recommendation.

Sub UserInput()

Dim rRange As range
Dim ws As Worksheet

Set rRange = Nothing
On Error Resume Next
Set rRange = Application.InputBox(Prompt:= _
"Please select a range for input.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0

If rRange Is Nothing Then
Exit Sub
End If


InValidEntry:
If Err = 13 Then
MsgBox "Not a valid input. " & "Please retry."
End If

rRange.Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.Location Where:=xlLocationAsObject, Name:="Chart"
ActiveChart.Legend.Select
Selection.Delete

Dim A As Integer
Dim B As Integer

A = 1
B = 2

Do

On Error GoTo ErrHandler:

ActiveChart.SeriesCollection(1).Points(A).Interior.ColorIndex = 4
ActiveChart.SeriesCollection(1).Points(B).Interior.ColorIndex = 7

A = A + 2
B = B + 2

Loop

ErrHandler: Exit Sub

End Sub
 
Back
Top