I have a worksheet with about 30 charts I want to update dynamically with a VBA macro. I have some issues in handling the series, but I can't find out what's wrong.
The code should run through several charts (only 3 in the following code), clear old contents, and add 6 new series with data taken from the spreadsheet. On the contrary, it doesn't delete the old series and, at each run, adds them again with a new one, then quits with a "Parameter not valid" error on line 22. I have been struggling on this for a couple of weeks now, and the most frustrating part is that the code is basically a copy+paste from another project, which works fine.
Here's the code:
Public Sub Refresh_NB_Graphs()
Dim cht As Chart
Dim chtObj As ChartObject
Dim vi As Integer
Dim s As Object
Dim j As Integer
Dim k As Integer
Dim seriesIndex As Integer
Dim xRange As Range
Dim yRange As Range
'Application.ScreenUpdating = False
On Error GoTo Errorcatch
'Graph fetching and update cycle
For vi = 1 To 3
Set chtObj = Sh_NBGain.ChartObjects("Ch_Gain_Vs" & CStr(vi))
Set cht = chtObj.Chart
' Adding or removing this section makes no difference -------
For Each s In cht.SeriesCollection
s.Delete
Next s
' -----------------------------------------------------------
cht.ChartArea.ClearContents
'Format Font Type and Size
cht.ChartType = xlXYScatterLinesNoMarkers ' scatter plot
cht.ChartArea.Format.TextFrame2.TextRange.Font.Name = "Arial"
cht.ChartArea.Format.TextFrame2.TextRange.Font.Size = 14
cht.HasTitle = False ' No chart title
' Add series: data origin in Sh_NBGainProcess
seriesIndex = 0
For j = 0 To 5
seriesIndex = seriesIndex + 1
cht.SeriesCollection.NewSeries
1 cht.SeriesCollection(seriesIndex).Name = CStr(Sh_Vars.Range("A8").Offset(j, 0).Value)
Set xRange = Sh_NBGainProcess.Range("C42:C1642").Offset(1600 * (vi - 1), 20 * j)
Set yRange = Sh_NBGainProcess.Range("D42:D1642").Offset(1600 * (vi - 1), 20 * j)
10 cht.SeriesCollection(seriesIndex).XValues = "='" & Sh_NBGainProcess.Name & "'!" & xRange.Address
20 cht.SeriesCollection(seriesIndex).Values = "='" & Sh_NBGainProcess.Name & "'!" & yRange.Address
22 With cht.SeriesCollection(seriesIndex)
23 Debug.Print seriesIndex
30 .Format.Line.Weight = 2.25
40 .Format.Line.Visible = msoTrue
50 .Format.Line.ForeColor.RGB = ECOPalette(j) ' Array with defined colors
60 .MarkerStyle = xlMarkerStyleNone
End With
Next j
'.....................
Next vi
End Sub
Can anybody help?
Thanks!
Had to rework the code a bit, but now it's fine:
Dim cht As Chart
Dim s As Series
Dim vi As Integer
Dim j As Integer
Dim xRange As Range
Dim yRange As Range
'Application.ScreenUpdating = False
On Error GoTo Errorcatch
'Graph fetching and update cycle
For vi = 1 To 3
' Gain charts (Vs 1 to 3) ***********************************************************************************************************
Set cht = Sh_NBGain.ChartObjects("Ch_Gain_Vs" & CStr(vi)).Chart
' Clear existing data
For Each s In cht.SeriesCollection
s.Delete
Next s
cht.ChartArea.ClearContents
cht.ChartType = xlXYScatterLinesNoMarkers ' scatter plot
' Add series: data origin in Sh_NBGainProcess
For j = 0 To 5
If Not Sh_NBGainProcess.Range("C42").Offset(1601 * (vi - 1), 20 * j).Value = "" Then
10 Set s = cht.SeriesCollection.NewSeries
40 s.Name = CStr(Sh_Vars.Range("A8").Offset(j, 0).Value)
50 Set xRange = Sh_NBGainProcess.Range("C42:C1642").Offset(1601 * (vi - 1), 20 * j)
60 Set yRange = Sh_NBGainProcess.Range("D42:D1642").Offset(1601 * (vi - 1), 20 * j)
90 s.XValues = "='" & Sh_NBGainProcess.Name & "'!" & xRange.Address
100 s.Values = "='" & Sh_NBGainProcess.Name & "'!" & yRange.Address
110 With s
130 .Format.Line.Weight = 2.25
140 .Format.Line.Visible = msoTrue
150 .Format.Line.ForeColor.RGB = ECOPalette(j)
160 .MarkerStyle = xlMarkerStyleNone
End With
End If
Next j
I think that the main issue was due to the use of the series collection indexing, which was somehow misbehaving (I still don't understand why). By referring directly to the series object when created, with Set s = cht.SeriesCollection.NewSeries, things go fine.
Related
Right now I have the following code to display a line curve. The number of inputs can vary and I want the chart to clear and draw a new line curve every time the macro is run.
Sub addchart()
If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If
Dim ws As Worksheet
Dim ch As chart
Dim ch1 As chart
Dim dt As Range
Dim i As Integer
i = Cells(Rows.Count, "I").End(xlUp).Row
Set ws = ActiveSheet
Set dt = Range(Cells(2, 10), Cells(i, 10))
Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).chart
With ch
.SetSourceData Source:=dt
.ChartTitle.Text = "Deflection Curve"
.ChartType = xlLine
.SeriesCollection(1).Name = "Deflection"
End With
If Application.WorksheetFunction.Min(dt) > -50 Then
With ch.Axes(xlValue)
.MinimumScale = -50
.MaximumScale = 0
End With
End If
End Sub
The chart that is printed looks something like this
I'm trying to figure out how to add labels to arbitrary points to the chart. Two labels to be specific. One is at the minimum value. And one is the value at any arbitrary point on x-axis. Both x-values are known and will be taken as inputs from two cells on the sheet. Something like this.
The style of highlighting is unimportant. Thanks for the help!
P.S. - I'm new to VBA and I'm learning everything on the go. I look up what I need to do and then try and imitate whatever examples I see online. So it's possible the existing program I've written for the chart might have unnecessary steps or is inefficient in some way. I would appreciate it if someone had any tips to offer to improve it, even though it does the job. Thanks!
Try those for first steps making chart labels:
Dim chartname as string
chartname = "enter_a_name"
ActiveSheet.Shapes.AddChart2(227, xlLine).Name = chartname
With ActiveSheet.Shapes(chartname).Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Weight = 1.5
End With
Set my_chart = ActiveSheet.ChartObjects(chartname).Chart
'Delete all Autolabels
my_chart.SetElement (msoElementDataLabelNone)
'Enter format of axis (just if you want to)
'With my_chart.Axes(xlCategory) ' axis adjustment
'.CategoryType = xlCategoryScale ' not XlCategoryType.xlAutomaticScale | XlCategoryType.xlTimeScale
'.TickLabels.NumberFormat = "DD.MM.YYYY hh:mm"
'.TickLabels.Orientation = xlUpward
'End With
cols = Array("F", "L") ' columns containing labels
For j = 1 To my_chart.SeriesCollection.Count
Set sc = my_chart.SeriesCollection(j)
For i = 2 To sc.Points.Count
sc.Points(i).ApplyDataLabels
sc.Points(i).DataLabel.Text = Range(cols(j - 1) & i + x).Value ' x= starting row containing values /labels
Next i
Sub addchart()
If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If
Dim ws As Worksheet
Dim ch As Chart
Dim dt As Range
Dim i As Integer
i = Cells(Rows.Count, "I").End(xlUp).Row
Set ws = ActiveSheet
Set dt = Range(Cells(2, 10), Cells(i, 11)) ' Added another column with the relevant values to highlight line chart
Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).Chart
With ch
.SetSourceData Source:=dt
.ChartTitle.Text = "Deflection Curve"
.FullSeriesCollection(1).ChartType = xlLine
.SeriesCollection(1).Name = "Deflection"
.SeriesCollection(2).ChartType = xlColumnStacked 'the second column shows up as a bar chart along with the line chart
End With
If Application.WorksheetFunction.Min(Range(Cells(2, 10), Cells(i, 10))) > -30 Then
With ch.Axes(xlValue)
.MinimumScale = -30
.MaximumScale = 0
End With
End If
End Sub
Thanks #Rory! I was able to fix it and now I got a new bug
Run time error 1004/parameter not valid
at at .SeriesCollection(j).XValues = ws.Range(rs)
Could someone please help me?
'''
I am trying to make multiple charts. And each chart would have 20 different groups with legend.
The way I have tried is first make multiple charts by columns and then add for/n loop in my code (here tried to have every 20 rows for one each group
Sub horizontal()
Dim sh As Shape
Dim ws As Worksheet
Dim ch As Chart
Dim rd As Range
Dim i As Integer, j As Integer, k As Integer
Set ws = Sheets("S1")
On Error Resume Next
ws.ChartObjects.Delete
On Error GoTo 0
For i = 20 To 45
Set rs = ws.Range("s2:s21")
Set rd = ws.Range("f1:j10")
Set sh = ws.Shapes.AddChart2(240, xlXYScatterLines)
Set ch = sh.Chart
For j = 1 To 20
k = j * 20
With ch 'shape.chart'
.SetSourceData Union(rs, ws.Range(ws.Cells(2, i), ws.Cells(21, i)))
.SeriesCollection.NewSeries
.SeriesCollection(j).XValues = ws.Range("s2:s21")
.SeriesCollection(j).Values = ws.Range(ws.Cells(k - 18, i), ws.Cells(k + 1, i))
.HasTitle = True
.ChartTitle.Text = ws.Range("T1")
.HasLegend = True
End With
Next j
With sh
.Name = "cht" & (i - 19)
.Top = (i - 20) * rd.Height
.Left = rd.Left
.Width = rd.Width
.Height = rd.Height
End With
Next i
End Sub
I tried the below two codes but they didn'twork.
Sub horizontal()
Dim sh As Shape
Dim ws As Worksheet
Dim ch As Chart
Dim rd As Range
Dim i As Integer, j As Integer, k As Integer
Set ws = Sheets("S1")
On Error Resume Next
ws.ChartObjects.Delete
On Error GoTo 0
For i = 20 To 45
Set rs = ws.Range("s2:s21")
Set rd = ws.Range("f1:j10")
Set sh = ws.Shapes.AddChart2(240, xlXYScatterLines)
Set ch = sh.Chart
With ch 'shape.chart'
.SetSourceData Union(rs, Range(Cells(2, i), Cells(21, i)))
.HasTitle = True
.ChartTitle.Text = ws.Range("T1")
.HasLegend = True
End With
With sh
.Name = "cht" & (i - 19)
.Top = (i - 20) * rd.Height
.Left = rd.Left
.Width = rd.Width
.Height = rd.Height
End With
Next i
End Sub
Sub diameter()
Dim ws As Worksheet
Dim sh As Shape
Dim ch As Chart
Dim rng As Range, rngTime As Range
Dim n As Integer, m As Integer, k As Integer, i As Integer
Set ws = Sheets("S1")
'delete previous plots
If ws.ChartObjects.Count > 0 Then
ws.ChartObjects.Delete
End If
Set rngTime = ws.Range(Cells(2, 19), Cells(21, 19))
ws.Shapes.AddChart2(240, xlXYScatterLines).Select
ws.Shapes(1).Chart.SetSourceData Union(rngTime, Range(Cells(2, 20), Cells(21, 20)))
'Source:=Range("'S1'!$S$2:$S$21,'S1'!$T$2:$T$21")
For n = 1 To 20
m = n * 20
With ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(n).XValues = ws.Range(Cells(2, 19), Cells(21, 19))
ActiveChart.FullSeriesCollection(n).Values = ws.Range(Cells(m - 18, 20), Cells(m + 1, 20))
End With
Next n
End Sub
'''
I have a VBA script that I use to generate multiple line charts in Excel. It used to include 2 series collections per chart (reading from 2 columns) but I since modified it for only one. However now I want it to do 2 series' again but want it to read both collections from the same column. Is this possible?
I've tried modifying the .SeriesCollection(2) to go to the next range further down the column. However this just returns an error 4001.
Sub CreateCharts()
Dim ws As Worksheet
Dim ch As Chart
Dim NumCharts As Integer, ChartName As String, ChartTitle As String, i As Integer
Set ws = Sheets("Charts")
NumCharts = WorksheetFunction.CountA(ws.Rows(2))
For i = 2 To NumCharts Step 1 '1 column of data per chart
ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
Set ch = Charts.Add
With ch
.ChartType = xlLine
.SetSourceData Source:=ws.Range(ws.Cells(3, i), ws.Cells(20, i)), _
PlotBy:=xlColumns 'range of data for each chart
.SeriesCollection(1).XValues = ws.Range("A3:A20") 'data range of line 1 (test data)
.SeriesCollection(2).XValues = ws.Range("A21:A38") 'data range of line 2 (Rw curve)
.Name = ChartName
.HasTitle = True
.ChartTitle.Characters.text = "#" & ws.Cells(2, i) '& " " & ws.Cells(1, i) 'remove title 'change to "ws.Cells(2, i)" to see titles
.ChartTitle.Left = 600
'HORiZONTAL X AXiS
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.text = "Frequency (Hz)"
.Axes(xlCategory).MajorTickMark = xlNone
.Axes(xlCategory).AxisBetweenCategories = False
.Axes(xlCategory).Border.LineStyle = None
'VERTiCAL Y AXiS
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.text = "Sound Reduction Index (dB)"
.Axes(xlValue).TickLabels.NumberFormat = "0"
.Axes(xlValue).MajorTickMark = xlNone
.Axes(xlValue).HasMajorGridlines = False
.Axes(xlValue).MinimumScale = 10 'minimum value on y
.Axes(xlValue).MaximumScale = 80 'maximum value on y
.Axes(xlValue).Border.LineStyle = None
'LEGEND
.HasLegend = False
'FONT SPECiFiCATiONS
.ChartArea.Format.TextFrame2.TextRange.Font.Size = 14
.ChartArea.Format.TextFrame2.TextRange.Font.Name = "Myriad Pro"
.ChartArea.Border.LineStyle = xlNone
'CHART POSiTiON, SiZE & COLOUR
.PlotArea.Format.Fill.ForeColor.RGB = RGB(242, 242, 242) 'grey background
.PlotArea.Top = 0
.PlotArea.Left = 20
.PlotArea.Height = 440
.PlotArea.Width = 420
'CHART LiNE COLOURS
.SeriesCollection(1).Border.Color = RGB(27, 117, 188) 'first line colour
'.SeriesCollection(2).Border.Color = RGB(0, 0, 0) 'second line colour
'.SeriesCollection(2).LineStyle = xlDashDot
End With
Next i
End Sub
Here is an image example of what I'm wanting to achieve.
Code is slightly modified and tested to work as far my understanding of the objective (to create one 2 series charts per column. 1st series Row 3-20 and 2nd series 21 to 38). Only issue with code was absence of SeriesCollection(2). It is modified to add necessary SeriesCollection and to delete if any automatically added series collection exist.
For i = 2 To NumCharts Step 1 '1 column of data per chart
ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
Set ch = Charts.Add
'Delete if any automatically added series exist
For x = ch.SeriesCollection.Count To 1 Step -1
ch.SeriesCollection(x).Delete
Next
With ch
.ChartType = xlLine
.SeriesCollection.Add ws.Range(ws.Cells(3, i), ws.Cells(20, i))
.SeriesCollection.Add ws.Range(ws.Cells(21, i), ws.Cells(38, i))
.SeriesCollection(1).XValues = ws.Range(ws.Cells(3, 1), ws.Cells(20, 1))
.SeriesCollection(2).XValues = ws.Range(ws.Cells(21, 1), ws.Cells(38, 1))
.Name = ChartName
I have created a chart using vba excel, then accidentally populate a graph that show the user and the counts which I prefer. But stupid of me I forgot to save, due to testing. Now I cant get the logic how to set it again. please help, thanks
Sample Data
Operator Counts Team
OPSHAF 123 A
OPSAJC 1245 B
OPSZAL 23 A
OPSJGY 162 C
OPSOSM 54 D
Sub CreateChart()
Dim rEmailRng As Range
Dim oEmailCht As Object
Dim cEmailCht As Chart
Dim coEmailCht As ChartObject
Dim iEmailRow As Integer
Dim sEmailSeries As Series
Dim scEmailSerCol As SeriesCollection
On Error Resume Next
Set wb = ThisWorkbook
Set wbsh2 = wb.Worksheets("Email")
Set coEmailCht = wbsh2.ChartObjects.Add(Range("E5").Left, Range("E5").Top, 500, 300)
coEmailCht = "Email Requests Processed" '& year
Set cEmailCht = coEmailCht.Chart
With cEmailCht
.HasLegend = False
.HasTitle = True
.Axes(xlValue).MinimumScale = 50
.Axes(xlValue).MaximumScale = 1500
.ChartTitle.Text = "Email Processed by Operator"
Set scEmailSerCol = .SeriesCollection
Set sEmailSeries = scEmailSerCol.NewSeries
With sEmailSeries
.Name = Range("A1").Offset(0, 1).Value
.XValues = Range(Range("A1").Offset(1, 0), Range("A1").End(xlDown))
.Values = Range(Range("A1").Offset(1, 1), Range("A1").Offset(1, 1).End(xlDown))
.ChartType = xl3DColumnClustered
End With
End With
Welcome To SO. If Your Objective is that axis label contain Count along with Operator then simply try
With sEmailSeries
'
.XValues = Range("A2:B" & Range("B2").End(xlDown).Row)
if you want team name also then
.XValues = Range("A2:C" & Range("C2").End(xlDown).Row)
I try to add in a given script some commands in order to automatically update the titles of charts (the charts are produced from the same script provided by Scott Holtzman).
My questions:
1. How can I escape quotes in order to update the text with given variables (I have read this can be done with double quotes ""i"" but it is not working)
2. It is possible to write greek characters and how?
3. It is possible to write with indices or lower case letters or subscripts?
4. How can I change the axes labels? I have defined two but I am changing only the y-axis and not the x-axis.
Here is my script (provided by Scott Holtzman) and my comments waht I am trying to do:
Sub MakeCharts()
Dim ws As Worksheet
Set ws = Sheets("Tabelle1")
Dim dthArray() As Variant
Dim kxArray() As Variant
Dim text1 As String
Dim text2 As String
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim j As Integer
i = 1
j = 1
' Strings for the charts'titles:
dthArray() = Array("0", "0,5", "1", "5", "10")
kxArray() = Array("0", "0,01", "1", "5")
For y = 1 To 259 Step 65
For x = 1 To 259 Step 13
ws.Shapes.AddChart.Select
With ActiveChart
.ChartType = xlXYScatterSmoothNoMarkers
Dim k As Integer
For k = 1 To 13
.SeriesCollection.NewSeries
.SeriesCollection(k).Name = ws.Cells(x, k + 1)
.SeriesCollection(k).XValues = ws.Range(ws.Cells(x + 1, k + 1), ws.Cells(x + 11, k + 1))
.SeriesCollection(k).Values = ws.Range(ws.Cells(x + 1, 1), ws.Cells(x + 11, 1))
.HasTitle = True
Next
.ApplyLayout (1)
Dim sName As String
sName = Replace(.Name, ws.Name & " ", "")
'Updating String for chart's title
text1 = dthArray(i)
text2 = kxArray(j)
' Write chart's title
.ChartTitle.Text = "dth=""text1""" & " " & "dx = ""text2"""
'sigma should be in greek and t as subscript
.Axes(xlValue, xlPrimary).AxisTitle.Text = "sigmat/a"
.Axes(xlValue, xlPrimary).AxisTitle.Text = "eta=y/H"
End With
With ActiveSheet.Shapes(sName)
.IncrementLeft 300
.IncrementTop x * 20
End With
i = i + 1
Next
j = j + 1
Next
End Sub
Any suggestions?