I have a number of charts in a excel file and each containing different series. On some series there are markers which are "No Fill" i.e. there is only border and no color. I want to change/fill color of only marker which are not filled already. I have made the following vba code but I am unable to understand why this code does not work. Here is my code:
Sub fillNoFillMarkers()
Dim oChart As ChartObject
Dim seriesIndex As Long
Dim pt As Point
Dim pointIndex As Long
Dim srs As Series
For Each oChart In ActiveSheet.ChartObjects
oChart.Activate
For Each srs In ActiveChart.SeriesCollection
For pointIndex = 1 To srs.Points.Count
If srs.Points(pointIndex).Format.Fill.Visible = msoFalse Then
srs.Points(pointIndex).MarkerBackgroundColor = RGB(0, 100, 0)
srs.Points(pointIndex).MarkerForegroundColor = RGB(100, 0, 0)
End If
Next pointIndex
Next srs
Next oChart
End Sub
srs.Points(pointIndex).Format.Fill.Visible = msoFalse does not return False if the MarkerBackgroundColor or MarkerForegroundColor are not colored...
Please, test the next adapted code:
Sub fillNoFillMarkers()
Dim oChart As ChartObject, seriesIndex As Long, pt As point
Dim pointIndex As Long, srs As Series
For Each oChart In ActiveSheet.ChartObjects
oChart.Activate
For Each srs In ActiveChart.SeriesCollection
For pointIndex = 1 To srs.points.count
Set pt = srs.points(pointIndex)
If pt.MarkerBackgroundColor = -4142 And pt.MarkerForegroundColor = -4142 Then
srs.points(pointIndex).MarkerBackgroundColor = RGB(0, 100, 0)
srs.points(pointIndex).MarkerForegroundColor = RGB(100, 0, 0)
End If
Next pointIndex
Next srs
Next oChart
End Sub
I used Set pt = srs.points(pointIndex), only because the variable was already declared and doing that you can benefit of intellisense suggestions and make the code more compact...
I was able to solve my problem with the help from FraneDuru. Here is my final Code:
Sub fillNoFillMarkers()
Dim oChart As ChartObject, seriesIndex As Long, pt As Point
Dim pointIndex As Long, srs As Series
For Each oChart In ActiveSheet.ChartObjects
oChart.Activate
For Each srs In ActiveChart.SeriesCollection
For pointIndex = 1 To srs.Points.Count
Set pt = srs.Points(pointIndex)
If pt.MarkerBackgroundColorIndex = xlNone Then
pt.MarkerBackgroundColor = RGB(100, 100, 0)
pt.MarkerForegroundColor = RGB(100, 0, 0)
End If
Next pointIndex
Next srs
Next oChart
End Sub
Related
I'm trying to colour my pie chart segments, according to the cells the data is drawn from, using Excel 2016.
I pinched code from a YouTube video but this is hard to read in places (1, l & i are particularly hard to differentiate) so I'm not convinced I have it right.
Private Sub SheetActivate(ByVal Sh As Object)
Dim cht As ChartObject
Dim i As Integer
Dim vntValues As Variant
Dim s As String
Dim mySeries As Series
For Each cht In ActiveSheet.ChartObjects
For Each mySeries In cht.Chart.SeriesCollection
If mySeries.ChartType <> xlPie Then GoTo SkipNotPie
s = Split(mySeries.Formula, ",")(2)
vntValues = mySeries.Values
For i = 1 To UBound(vntValues)
mySeries.Points(i).Interior.Color = Range(s).Cells(i).Interior.Color
Next l
SkipNotPie:
Next mySeries
Next cht
End Sub
Update: here is a snip showing the charts - I'm trying to update the chart segments to represent the cell fill colours in the second column.
With minor adjustments, this worked fine:
Private Sub SheetActivate()
Dim cht As ChartObject
Dim i As Long
Dim vntValues As Variant
Dim s As String
Dim mySeries As Series
For Each cht In ActiveSheet.ChartObjects
For Each mySeries In cht.Chart.SeriesCollection
If mySeries.ChartType <> xlPie Then GoTo SkipNotPie
s = Split(mySeries.Formula, ",")(2)
vntValues = mySeries.Values
For i = 1 To UBound(vntValues)
mySeries.Points(i).Interior.Color = Range(s).Cells(i).Interior.Color
Next i
SkipNotPie:
Next mySeries
Next cht
End Sub
Make sure you don't have Option Base 1 at the top of the module. If you do, then change
s = Split(mySeries.Formula, ",")(2)
to
s = Split(mySeries.Formula, ",")(3)
I haven't used Option Base 1 since I learned to count starting at zero.
I have this PivotChart in Excel 2016
As you can see there are two properties in the axis field: "Date" and "Category".
There are two possible values for "Category": ASC and SBT.
Right now the bars related to either values are of the same colors (Red and Blue).
I want that if the "Category" is SBT, the colors of the bars must be different (for example, yellow and green). How can I achieve that?
Thanks
Try this.
Sub test()
Dim obj As ChartObject
Dim cht As Chart
Dim pnt As Point
Dim Ws As Worksheet
Dim s As String
Set Ws = ActiveSheet
Set obj = Ws.ChartObjects(1)
Set cht = obj.Chart
With cht
.ApplyDataLabels
For Each pnt In .SeriesCollection(1).Points
With pnt.DataLabel
.ShowCategoryName = True
.ShowValue = False
End With
s = pnt.DataLabel.Text
If InStr(s, "SBT") Then
pnt.Format.Fill.ForeColor.RGB = RGB(255, 2255, 0)
End If
With pnt.DataLabel
.ShowCategoryName = False
End With
Next pnt
For Each pnt In .SeriesCollection(2).Points
With pnt.DataLabel
.ShowCategoryName = True
.ShowValue = False
End With
s = pnt.DataLabel.Text
If InStr(s, "SBT") Then
pnt.Format.Fill.ForeColor.RGB = RGB(29, 219, 22)
End If
With pnt.DataLabel
.ShowCategoryName = False
End With
Next pnt
End With
End Sub
I have this code to create a chart:
Sub CreateChart()
Dim rng As Range
Dim cht As Object
Set rng = ActiveSheet.Range("A4:C8")
Set cht = ActiveSheet.Shapes.AddChart2
cht.Chart.SetSourceData Source:=rng, PlotBy:=xlColumns
cht.Chart.ChartType = xlBarStacked
cht.SeriesCollection(1).Interior.Color = RGB(255, 255, 255)
End Sub
But the series 1 bars are not changing the color.
Can you help?
Thanks!
See answer below, it implements what you wanted in your post, in a different method, allowing you more flexibility in the future:
Option Explicit
Sub CreateChart()
Dim rng As Range
Dim cht As ChartObject
Dim cht_Series As Series
Set rng = ActiveSheet.Range("A4:C8")
' in brackets (Left, Width, Top, Height) >> modify according to your needs
Set cht = ActiveSheet.ChartObjects.Add(100, 100, 100, 100)
With cht
.Chart.SetSourceData Source:=rng
.Chart.PlotBy = xlColumns
.Chart.ChartType = xlBarStacked
End With
Set cht_Series = cht.Chart.SeriesCollection(1)
' this will result to white (by your post) >> modify to your desired color
cht_Series.Format.Fill.ForeColor.RGB = RGB(255, 255, 255)
End Sub
Try this :
Sub CreateChart()
Dim rng As Range
Set rng = ActiveSheet.Range("A4:C8")
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.SetSourceData Source:=Range("Feuil1!$A$4:$B$8")
.SeriesCollection.NewSeries
.SetSourceData Source:=rng, PlotBy:=xlColumns
.ChartType = xlBarStacked
.SeriesCollection(1).Interior.ColorIndex = 5 'Change value to change color
End With
End Sub
and choose the value in the color index table. 5 correspond to blue. You can get the color index table here .
I'm trying to automate plotting of a box and whiskers chart. The code below compiles and runs but the error bars do not appear in the chart.
Dim ws As Worksheet
Dim datarange As Range
Dim chtChart As Chart
Dim objChrt As ChartObject
Set ws = Sheets("sheet1")
Set datarange = ws.Range("F8:G10")
Set chtChart = Charts.add
With chtChart
chtChart.ChartType = xlColumnStacked
chtChart.SetSourceData Source:=datarange, PlotBy:=xlColumns
With .Axes(xlCategory, xlPrimary)
.CategoryNames = ws.Range("A2:A13")
.TickLabels.Font.Bold = True
End With
.SeriesCollection(1).Format.Fill.Visible = msoFalse
.SeriesCollection(2).Format.Fill.Visible = msoTrue
Dim Sec1 As Series
Set Sec1 = .SeriesCollection.NewSeries
.SeriesCollection(3).HasErrorBars = True
.SeriesCollection(3).ErrorBars.EndStyle = xlCap
.SeriesCollection(3).ErrorBars.Format.Line.Visible = msoTrue
.SeriesCollection(3).ErrorBars.Format.Line.ForeColor.RGB = RGB(0, 0, 0)
.SeriesCollection(3).ErrorBars.Format.Line.Transparency = 0
.SeriesCollection(3).ErrorBars.Format.Line.Weight = 1.5
.SeriesCollection(3).ErrorBar Direction:=xlX, Include:=xlErrorBarIncludeBoth, Type:=xlErrorBarTypeCustom, Amount:="=CHART!F12:G12", MinusValues:="=CHART!F12:G12"
Solved.
.SeriesCollection(3).values= <data range for whisker length>
type variant, data values required to plot whiskers
IMPORTANT: this overwrites the series collection values (seriescollection(3) in this case)
values can be replaced after plotting whiskers
I'm comparing two series and if the value of the 2nd series is less than the 1st at a given XValue, I want to make the bar for that 2nd series red. I tried following some other forum answers and got to this but now I'm stuck...
Public Sub Bar_Colour()
Dim c As Chart
Dim p As Series
Dim a As Series
Dim iPoint As Long
Dim nPoint As Long
Set c = ActiveChart
Set s = ActiveChart.SeriesCollection(1)
Set a = ActiveChart.SeriesCollection(2)
nPoint = s.Points.Count
For iPoint = 1 To nPoint
If a.Points(iPoint).Value < s.Points(iPoint).Value Then
a.Points(iPoint).Interior.Color = RGB(255, 0, 0)
End If
Next iPoint
End Sub
Thanks!
Public Sub Bar_Colour()
Dim c As Chart
Dim p As Series
Dim a As Series
Dim iPoint As Long
Dim nPoint As Long
Set c = ActiveChart
Set s = ActiveChart.SeriesCollection(1)
Set a = ActiveChart.SeriesCollection(2)
nPoint = s.Points.Count
For iPoint = 1 To nPoint
If a.Values(iPoint) < s.Values(iPoint) Then
a.Points(iPoint).Interior.Color = RGB(255, 0, 0)
End If
Next iPoint
End Sub