I am novice in VBA Excel and I have a column chart with multiple columns. I want to be able to set a column's color depending on it's value. At the moment I can select my Chart object and the SeriesCollection, in addition, I can see what values each column has. This is my code:
Sub changeChartColumnColor()
Dim ChtObj As ChartObject
Dim mySrs As Series
Dim myPts As Points
Dim x As Variant
For Each ChtObj In Worksheets("MyWorkSheet").ChartObjects
If ChtObj.Name = "My Chart" Then
For Each mySrs In ChtObj.Chart.SeriesCollection
For Each x In mySrs.Values
MsgBox x
Next x
Next mySrs
End If
Next ChtObj
End Sub
I tried looking it up in internet and on this website but I am not able to find any relevant information. Please note that I know how to change the color for the whole SeriesCollection (mySrs.Interior.Color = RGB(0, 255, 255)).
My problem is: How to change the color of each of the series' columns?
Thank you!
Related
I created an Excel 2016 VBA scatter chart (separate worksheet w/o legends) and labeled the points with VBA. Source labels are A1:A3 (Events (35-chars) / Date / Y-points) and Data is A2:C17. My labels (orientation -90) overwrite the Y-points and bunch up because the Y-axis plot area takes up the entire worksheet. I have tried different Y-axis values but the plot area expands to fill the worksheet. I have also tried to change the plot size with VBA. I need the labels above the actual chart plot.
The secondary issue is I cannot plot a Date & Time, just a Date and have a problem creating Error Bars with xlMinusValues 100% and SeriesCollection(1).
I have been doing this in separate modules for ease of use, but will be combining or using a Call. I find I cannot build a chart with more than 16 data records, so I will be working on a looping routine if more records are present.
TIMELINE MODULE
Option Explicit
Sub Timeline()
Dim sCount As Long
Dim labelrotation As Long
Dim TimelineChart As Chart
Dim LastCell As Long
Dim rng As Range
Dim rngAddr As String
Dim ChartRange As String
With ActiveSheet
Range("C1").End(xlDown).Activate
Set rng = ActiveCell
rngAddr = rng.Address(0, 0)
End With
Let ChartRange = "B2:" & rngAddr
Set TimelineChart = Charts.Add
TimelineChart.Name = "TimelineChart"
With TimelineChart
.SetSourceData Sheets("TimelineData").Range(ChartRange)
.ChartType = xlXYScatter
.Legend.LegendEntries(1).Delete
TimelineChart.HasAxis(xlSecondary) = False
End With
End Sub
LABEL MODULE
Option Explicit
Sub Labels()
Dim r As Range
Dim Events As Range
Dim EventCounter As Integer
Dim s As Series
Sheets("TimelineData").Select
Set Events = Range("A2", Range("A1").End(xlDown))
Set s = Chart1.SeriesCollection(1)
s.HasDataLabels = True
For Each r In Events
EventCounter = EventCounter + 1
s.Points(EventCounter).DataLabel.Text = r.Value
s.Points(EventCounter).DataLabel.Position = xlLabelPositionAbove
s.Points(EventCounter).DataLabel.Orientation = 45
Next r
End Sub
I am going to withdraw the question. The scatter plot was on a chart sheet versus in the same worksheet as the table from which data is used. Lots of hours spent with a conclusion I should use a bar chart, same worksheet, modified.
Thanks to all that looked and considered a response.
I found Hide data label containing series name if value is zero on Super User but it removes data labels that have a value of 0 for all charts:
Sub RemoveZeroValueDataLabel()
'runs through every chart on the ActiveSheet
Dim cht As Chart
Dim chtObj As ChartObject
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
Dim ser As Series
For Each ser In cht.SeriesCollection
Dim vals As Variant
vals = ser.Values
'include this line if you want to reestablish labels before deleting
ser.ApplyDataLabels xlDataLabelsShowLabel, , , , True, False, False, False, False
'loop through values and delete 0-value labels
Dim i As Integer
For i = LBound(vals) To UBound(vals)
If vals(i) = 0 Then
With ser.Points(i)
If .HasDataLabel Then
.DataLabel.Delete
End If
End With
End If
Next i
Next ser
Next chtObj
End Sub
I tried to edit it myself:
Sub RemoveZeroValueDataLabelonlyonechart()
Dim cht As Chart
Dim chtObj As ChartObject
Set cht = chtObj.Chart
Dim ser As Series
For Each ser In cht.SeriesCollection
Dim vals As Variant
vals = ser.Values
'include this line if you want to reestablish labels before deleting
ser.ApplyDataLabels xlDataLabelsShowLabel, , , , True, False, False, False, False
'loop through values and delete 0-value labels
Dim i As Integer
For i = LBound(vals) To UBound(vals)
If vals(i) = 0 Then
With ser.Points(i)
If .HasDataLabel Then
.DataLabel.Delete
End If
End With
End If
Next i
Next ser
End Sub
But this returns:
Microsoft visual basic | Run-time error '91' | Object variable or With block variable not set
How can I edit the code so it only removes data labels from the chart I have selected, not all charts in the sheet?
Dim chtObj As ChartObject
In the original loop chtObj loops on all the chart objects in the ActiveSheet. Here you want to set it only on a specific Chart object, so you removed the For loop, fine. But your chtObj, which you defined as a reference to a ChartObject, references nothing up till now. You need to assign it to some Chart object. You need to know either the name or the index of the Chart object you want to modify. Then you will add one simple line after the one above:
Set chtObj = ActiveSheet.ChartObjects("someName")
or, if the chart is the first one created within that worksheet:
Set chtObj = ActiveSheet.ChartObjects(1)
After you add one of these two lines, with the appropriate name or number that corresponds to the target Chart, the rest of the code should work fine.
I work heavily with PivotCharts, but have absolutely zero VBA experience. I have excel templates that are uploaded to a database, then can be downloaded as a report with the data from that database. I have a pivotTable/PivotChart combo on one sheet. Sometimes the table has 5 rows of data, and sometimes is has 1200 rows of data, depending on the database, timeframe, etc.
What I'd like to do, is have the chart take up the same number of rows as the table + 3 in height, and always display in D3:J3 for width and starting position. This aligns the data with the charts.
I have found a similar ? from last year here: Resize pivot chart when selecting different less/more values
It has not gotten me any results (or I'm doing something wrong).
Relevant info: table/chart is on Sheet4 ("Summary"), and under PivotTable Options, it is called "IdleSummary".
I appreciate any help that can be given, thanks!
One way to do it, is to use a range object to size your chart like so:
Sub test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Summary")
Dim vPiv As PivotTable
Dim vRowCount As Long
Dim graphSizer As Range
Dim theChart As ChartObject
Set vPiv = ws.PivotTables("IdleSummary")
vRowCount = ws.Range(vPiv.TableRange2.Address).Rows.Count + 3
Set graphSizer = ws.Range("D3:J" & vRowCount)
Set theChart = ws.ChartObjects.Add(Left:=graphSizer.Left, Top:=graphSizer.Top, Width:=graphSizer.Width, Height:=graphSizer.Height)
With theChart.Chart
.SetSourceData vPiv.TableRange2
.ChartType = xlArea 'replace with desired chartType
End With
End Sub
EDIT, to answer comments:
Modifying the above code, and using the worksheet PivotTableUpdate event you could do like so:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
If Target.Name = "IdleSummary" Then
Call Resize
End If
End Sub
Sub Resize()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Summary")
Dim vPiv As PivotTable
Dim vRowCount As Long
Dim graphSizer As Range
Dim theChart As ChartObject
Dim charObj As ChartObject
Set vPiv = ws.PivotTables("IdleSummary")
vRowCount = ws.Range(vPiv.TableRange2.Address).Rows.Count + 3
Set graphSizer = ws.Range("D3:J" & vRowCount)
Set theChart = ws.ChartObjects(1)
With theChart.Chart.Parent
.Left = graphSizer.Left
.Top = graphSizer.Top
.Width = graphSizer.Width
.Height = graphSizer.Height
End With
End Sub
This is assuming you have just one chart, else you can replace the index (1) with the chart name, e.g. ("Chart 1"). If you interested in reading about events you can find an introduction here: http://www.cpearson.com/excel/Events.aspx
I don't have experience with VBA and I'm trying to format all of the pie charts on one active sheet based on the colors of their data cells in Excel 2010. I found this code from: http://datapigtechnologies.com/blog/index.php/color-pie-chart-slices-to-match-their-source-cells/
Sub ColorPies()
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 i
SkipNotPie:
Next myseries
Next cht
End Sub
This code works well, however it is unable to pick up the colors from conditional formatting.
I came across this solution for VBA to read conditional formatting colors:
Selection.FormatConditions(1).BarColor.Color
However I've been unable to implement it in the above block of VBA. I tried replacing Interior.Color with different parts of it and none seem to work. Does anyone know a simple way to do this?
Thank you in advance!
Since you have 2010, you can use the DisplayFormat property:
For i = 1 To UBound(vntValues)
myseries.Points(i).Interior.Color = Range(s).Cells(i).DisplayFormat.Interior.Color
Next i
I'm having an issue with the looping through of several charts in my VBA code. I'm 99.7% sure that this is a really easy and quick fix but my brain isn't working today.
I want the code to loop through every chart on the ActiveSheet, and for every data series that the chart contains I want it to add the last value of the series. In my example I have 9 charts, each with 3 series in them (bound to change, some have 2 but I digress).
I have the following code
Sub AddLastValue()
Dim myChartObject As ChartObject
Dim myChart As Chart
Dim mySrs As Series
Dim myPts As Points
With ActiveSheet
For Each myChartObject In .ChartObjects
For Each myChart In .Chart
For Each mySrs In .SeriesCollection
Set myPts = .Points
myPts(myPts.Count).ApplyDataLabels Type:=xlShowValue
Next
Next
Next
End With
End Sub
If I remove the looping code and just do a
Set myPts = ActiveSheet.ChartObjects(1).Chart. _
SeriesCollection(1).Points
myPts(myPts.Count).ApplyDataLabels type:=xlShowValue
Then it works for that specific chart and series, so I'm positive it is the looping that I'm messing up.
Could someone tell me where I mess up the looping code?
Try following code:
Sub AddLastValue()
Dim myChartObject As ChartObject
Dim mySrs As Series
Dim myPts As Points
With ActiveSheet
For Each myChartObject In .ChartObjects
For Each mySrs In myChartObject.Chart.SeriesCollection
Set myPts = mySrs.Points
myPts(myPts.Count).ApplyDataLabels Type:=xlShowValue
Next
Next
End With
End Sub
Not work for empty values.
This code find last not empty value and then adds label.
For Each mySrs In myChartObject.Chart.SeriesCollection
Set myPts = mySrs.Points
Dim i As Integer
i = myPts.Count
Do Until i < 2 Or mySrs.Values(i) <> ""
i = i - 1
Loop
myPts(i).ApplyDataLabels Type:=xlShowValue
Next