How to create an automated dynamic line graph in Excel VBA
To manipulate the Series title (you only have one series in each of these charts) you could do simply:
With ActiveChart.SeriesCollection(1)
.Name = "RPM"
'## You can further manipulate some series properties, like: '
'.XValues = range_variable '## you can assign a range of categorylabels here'
'.Values = another_range_variable '## you can assign a range of Values here'
End With
Now, what code you have is adding charts to the sheet. But once they have been created, presumably you don't want to re-add a new chart, you just want to update the existing chart.
Assuming you only will have one series in each of these charts, you could do something like this to update the charts.
How it works is by iterating over each chart in the worksheet's chartobjects collection, and then determining what Range to use for the Series Values, based on the chart's title.
REVISED to account for the third chart which has 2 series.
REVISED #2 To add series to chart if chart does not have series data.
Sub UpdateCharts()
Dim cObj As ChartObject
Dim cht As Chart
Dim shtName As String
Dim chtName As String
Dim xValRange As Range
Dim LastRow As Long
With ActiveSheet
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
Set xValRange = .Range("B2:B" & LastRow)
shtName = .Name & " "
End With
'## This sets values for Series 1 in each chart ##'
For Each cObj In ActiveSheet.ChartObjects
Set cht = cObj.Chart
chtName = shtName & cht.Name
If cht.SeriesCollection.Count = 0 Then
'## Add a dummy series which will be replaced in the code below ##'
With cht.SeriesCollection.NewSeries
.Values = "{1,2,3}"
.XValues = xValRange
End With
End If
'## Assuming only one series per chart, we just reset the Values & XValues per chart ##'
With cht.SeriesCollection(1)
'## Assign the category/XValues ##'
.XValues = xValRange
'## Here, we set the range to use for Values, based on the chart name: ##'
Select Case Replace(chtName, shtName, vbNullString)
Case "RPM"
.Values = xValRange.Offset(0, 3) '## Column E is 3 offset from the xValRange in column B
Case "Pressure/psi"
.Values = xValRange.Offset(0, 5) '## Column G is 5 offset from the xValRange in column B
Case "Third Chart"
.Values = xValRange.Offset(0, 6) '## Column H is 6 offset from the xValRange in column B
'## Make sure this chart has 2 series, if not, add a dummy series ##'
If cht.SeriesCollection.Count < 2 Then
With cht.SeriesCollection.NewSeries
.XValues = "{1,2,3}"
End With
End If
'## add the data for second series: ##'
cht.SeriesCollection(2).XValues = xValRange
cht.SeriesCollection(2).Values = xValRange.Offset(0, 8) '## Column J is 8 offset from the xValRange in column B
Case "Add as many of these Cases as you need"
End Select
End With
Next
End Sub
REVISION #3 To allow for creation of charts if they do not already exist in the worksheet, add these lines to the bottom of your DeleteRows_0_Step()
subroutine:
Run "CreateCharts"
Run "UpdateCharts"
Then, add these subroutines to the same code module:
Private Sub CreateCharts()
Dim chts() As Variant
Dim cObj As Shape
Dim cht As Chart
Dim chtLeft As Double, chtTop As Double, chtWidth As Double, chtHeight As Double
Dim lastRow As Long
Dim c As Long
Dim ws As Worksheet
Set ws = ActiveSheet
lastRow = ws.Range("A1", Range("A2").End(xlDown)).Rows.Count
c = -1
'## Create an array of chart names in this sheet. ##'
For Each cObj In ActiveSheet.Shapes
If cObj.HasChart Then
ReDim Preserve chts(c)
chts(c) = cObj.Name
c = c + 1
End If
Next
'## Check to see if your charts exist on the worksheet ##'
If c = -1 Then
ReDim Preserve chts(0)
chts(0) = ""
End If
If IsError(Application.Match("RPM", chts, False)) Then
'## Add this chart ##'
chtLeft = ws.Cells(lastRow, 1).Left
chtTop = ws.Cells(lastRow, 1).Top + ws.Cells(lastRow, 1).Height
Set cObj = ws.Shapes.AddChart(xlLine, chtLeft, chtTop, 355, 211)
cObj.Name = "RPM"
cObj.Chart.HasTitle = True
Set cht = cObj.Chart
cht.ChartTitle.Characters.Text = "RPM"
clearChart cht
End If
If IsError(Application.Match("Pressure/psi", chts, False)) Then
'## Add this chart ##'
With ws.ChartObjects("RPM")
chtLeft = .Left + .Width + 10
chtTop = .Top
Set cObj = ws.Shapes.AddChart(xlLine, chtLeft, chtTop, 355, 211)
cObj.Name = "Pressure/psi"
cObj.Chart.HasTitle = True
Set cht = cObj.Chart
cht.ChartTitle.Characters.Text = "Pressure/psi"
clearChart cht
End With
End If
If IsError(Application.Match("Third Chart", chts, False)) Then
'## Add this chart ##'
With ws.ChartObjects("Pressure/psi")
chtLeft = .Left + .Width + 10
chtTop = .Top
Set cObj = ws.Shapes.AddChart(xlLine, chtLeft, chtTop, 355, 211)
cObj.Name = "Third Chart"
cObj.Chart.HasTitle = True
Set cht = cObj.Chart
cht.ChartTitle.Characters.Text = "Third Chart"
clearChart cht
End With
End If
End Sub
Private Sub clearChart(cht As Chart)
Dim srs As Series
For Each srs In cht.SeriesCollection
If Not cht.SeriesCollection.Count = 1 Then srs.Delete
Next
End Sub
TMC
Updated on July 23, 2022Comments
-
TMC almost 2 years
I have a work problem. I have a data report with tons of information in it and I need to create 3 line graphs to represent 3 different values over time. The time is also in the report and is the same time for all of the values. I am having trouble finding a solution specific to me in forums elsewhere.
The data report varies in length, rows. What I need to do is to create the 3 line graphs and have them positioned horizontally, a few rows under the end of the report. Two of the graphs have one series each and the third has two series.
This is what the graphs need to include:
Graph 1: RPM over Time
Graph 2: Pressure over Time
Graph 3: Step burn off and Demand burn off over TimeI am just getting into VBA because of a recent position change at work and I know very little about it but I have spent a lot of time figuring out how to write other macros for the same report. Since my verbal representation of the workbook is unclear I have attached a link to a sample of the data report for viewing.
Here is what I have so far. It works for the first chart. Now what can I put in the code to name the chart "RPM" and to name the series "RPM"?
Sub Test() Dim LastRow As Long Dim Rng1 As Range Dim ShName As String With ActiveSheet LastRow = .Range("B" & .Rows.Count).End(xlUp).Row Set Rng1 = .Range("B2:B" & LastRow & ", E2:E" & LastRow) ShName = .Name End With Charts.Add With ActiveChart .ChartType = xlLine .SetSourceData Source:=Rng1 .Location Where:=xlLocationAsObject, Name:=ShName End With End Sub
I have figured out how to put the chart name in via VBA. The code now looks like this:
Sub Test() Dim LastRow As Long Dim Rng1 As Range Dim ShName As String With ActiveSheet LastRow = .Range("B" & .Rows.Count).End(xlUp).Row Set Rng1 = .Range("B2:B" & LastRow & ", E2:E" & LastRow) ShName = .Name End With Charts.Add With ActiveChart .ChartType = xlLine .HasTitle = True .ChartTitle.Text = "RPM" .SetSourceData Source:=Rng1 .Location Where:=xlLocationAsObject, Name:=ShName End With End Sub
I will next be working on the series title and then on to having the chart place itself under the report data. Suggestions and comments welcome.
The updated code below creates the rpm chart and the pressure chart separately. The last chart needs two series and I am working on that now.
Sub chts() 'RPM chart------------------------------------- Dim LastRow As Long Dim Rng1 As Range Dim ShName As String With ActiveSheet LastRow = .Range("B" & .Rows.Count).End(xlUp).Row Set Rng1 = .Range("B2:B" & LastRow & ", E2:E" & LastRow) ShName = .Name End With Charts.Add With ActiveChart .ChartType = xlLine .HasTitle = True .ChartTitle.Text = "RPM" .SetSourceData Source:=Rng1 .Location Where:=xlLocationAsObject, Name:=ShName End With With ActiveChart.SeriesCollection(1) .Name = "RPM" End With ' Pressure chart -------------------------------- Dim LastRow2 As Long Dim Rng2 As Range Dim ShName2 As String With ActiveSheet LastRow2 = .Range("B" & .Rows.Count).End(xlUp).Row Set Rng2 = .Range("B2:B" & LastRow2 & ", G2:G" & LastRow2) ShName2 = .Name End With Charts.Add With ActiveChart .ChartType = xlLine .HasTitle = True .ChartTitle.Text = "Pressure/psi" .SetSourceData Source:=Rng2 .Location Where:=xlLocationAsObject, Name:=ShName2 End With With ActiveChart.SeriesCollection(1) .Name = "Pressure" End With End Sub
David, I am curious to see how your code works with my worksheet but I'm not sure how to fix the syntax error.
-
TMC about 11 yearsI copied your code to see how it works on my worksheet but I keep getting a syntax error at 'Set xValRange = '. And just to inform you the last chart will actually have two series. I will continue to look through the MSDN Office Reference page.
-
TMC about 11 yearsAlso please note that I am trying to put all three chart coding in one module because I plan on attaching this one macro to a button for one click ease. This is just to cut time out of creating the reports for clients and being able to do them as quickly as possible. I appreciate all of the help and input so far.
-
David Zemens about 11 yearsWhen you get the error, what is the error message and what is the value of
lastRow
variable? -
TMC about 11 yearsI'm not sure what you mean. I copied your code exactly as it is. Forgive my lack of knowledge. Am I supposed to specify the lastRow variable further? As of now I just get the message that there is a syntax error at the second instance of "Set xValRange ="
-
David Zemens about 11 yearsOoops! I see that now. Delete that line -- not sure why it's there but it shouldn't be there! Sorry! I will revise :)
-
TMC about 11 yearsHa, it's okay! I took it out and now I get a "Compile Error: Invalid or Unqualified reference" at the line "With .SeriesCollection(1)"
-
David Zemens about 11 yearsTry now. Should be
With cht.SeriesCollection(1)
. Code has also been updated and hopefully should update the third chart (the one with 2 series), too. You will need to modify it to refer to the correct chart name. -
David Zemens about 11 yearswell hold that thought> I've downloaded your workbook. Let me play with it for a few minutes. Will update shortly.
-
David Zemens about 11 yearsOK. Try the revision. I downloaded your file, created the charts, and use the macro above to update the series data for each of them.
-
TMC about 11 yearsOkay, what I did was created three blank charts and named them. I changed the name of the third chart in your code. Then I launched the macro and got the same Compile Error at "With cht.SeriesCollection(1)".
-
David Zemens about 11 yearsThis code doesn't add series to the chart, it just updates existing series. I can probably modify it to check if series exists, first. Give me a few...
-
TMC about 11 yearsOkay. Well to explain further the data sheets will be filled with new data every time, trimmed, and then have the charts created. I wont be adding new data to the same report because the report is for one weld. After the charts are made the report will be saved and I will start a new worksheet for the next report. I will just have all of the macros saved on the worksheet template.
-
David Zemens about 11 yearsOK. Code's updated now and it will check to see if the chart has any series data, so if you have blank charts, it will add the series data to them.
-
TMC about 11 yearsWell it does work. Only problem now is that the charts disappear before I can fill them! Ha! I made the blank charts saved the template, opened a new data log and trimmed out the rows I didn't need but as the rows deleted the charts were also delete or were moved to the back of the data so I can't see them. If I create the blank charts after the trim it works perfectly.
-
TMC about 11 yearsThis is why I was trying to get the feature that would create the charts after the trim and place them horizontally under the report information.
-
TMC about 11 yearsI suppose I could record a macro with a hot key that would create the three blank charts, allowing me to hot key them after the trim but I would still have to drag the chart to the bottom since the reports vary in length.
-
David Zemens about 11 years@TMC no need for that. see revision #3. This will create the charts if they do not already exist.
-
TMC about 11 yearsI am putting the run commands inside of the Sub DeleteRows_0_Step at the end and putting the sub routines inside of your update charts subroutine?
-
David Zemens about 11 yearsTry it like here: docs.google.com/file/d/0B1v0s8ldwHRYOWNjM0RPSmkxbEE/…
-
David Zemens about 11 yearsYou're going to have to download the file. It should contain
Module1
with all subroutines inside it. -
TMC about 11 yearsOkay I will try this code with a different report with a different length and see how it goes.
-
TMC about 11 yearsIt's messing up a little. I will be breaking for lunch but I will be responsive in about an hour.
-
David Zemens about 11 yearsThis is really about as much time as I can afford to give away. Good luck.
-
David Zemens about 11 yearsIf it's been helpful, you don't have to "accept" it, but please consider upvoting my answer.
-
TMC about 11 yearsIt has helped. I'm nearly there now just needs a slight tweak. I will upvote because it is a very detailed and helpful answer.
-
TMC about 11 yearsIf anyone can help me further the current code throws a "Run-time error '5': Invalid procedure call or argument" at the line 'If IsError(Application.Match("RPM", chts, False)) Then'
-
David Zemens about 11 yearsYep I had fixed that in my answer above, but apparently the revision I didn't update the XLS file. Try now. docs.google.com/file/d/0B1v0s8ldwHRYSEd5N0FGMFRON2s/…
-
TMC about 11 yearsCannot run macro "UpdateCharts". The macro may not be available in this workbook. David I understand that you have probably spent a lot more time than you wanted on this. I understand if you would like to move on. I will try to get others to help me.
-
David Zemens about 11 yearsYou may have to enable editing, or check your macro security? Otherwise, maybe try changing
Private Sub ...
to justSub ...
for each of the subroutines declared as Private. -
TMC about 11 yearsI figured out what it was. I still had the other UpdateCharts module in the list. Deleted and it works fine. Thank you.
-
TMC about 11 yearsOne last thing David, which value do I have to change if I want to make the charts go lower than the last line? A quick answer will be fine.
-
David Zemens about 11 years
chtTop = ws.Cells(lastRow, 1).Top + ws.Cells(lastRow, 1).Height
this sets the position of the first chart, which is then a reference for the other charts. For example, changelastRow
in both places on this line, tolastRow + 3
and that will put the charts 3 rows beneat the last row. -
TMC about 11 yearsOkay I will try that. The problem is it is erasing the calculated weld time from the DeleteRows_0_Step.
-
David Zemens about 11 yearsWell I don't think it's erasing anything, it may be hiding or laying over it, but it's not erasing anything. You may want to change where it's printing out that value. Currently you're putting it in column B below the last row. I'd probably just put it in cell Z1.
-
David Zemens about 11 years
Cells(1, 26) = Format(Cells(Var, 2) - Cells(2, 2), "[hh]:mm:ss")