How to create an automated dynamic line graph in Excel VBA

Question

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

Answer 1

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