One Range, Two Colors

[ryguy7272]

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---

 

[John Mansfield]

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

 

[Jon Peltier]

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

 

[Jon Peltier]

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

 

[ryguy7272]

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