# How to create an automated dynamic line graph in Excel VBA

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 Time

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

## Answers

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