CODEWITHSUNDEEP
vbaexcelchartsseries
Liz
Liz

Reputation: 1

Excel - Multiple Charts on same Worksheet - subsequent executions of my code replace Series incorrectly

I would like to show different interpretations of the same data via multiple embedded charts on the same worksheet. The first time I execute the VBA code it works fine, but then subsequent uses of the code end up with unexpected behavior.

I have invoked a Value change event on one cell that is a dropdown list of categories from which to select one value. That selection then filters the data below it. The multiple embedded charts then show interpretation based on the filtered data.

Specifically, the first embedded chart has a "Score" on the y-axis from one column in my data versus "Records" on the x-axis from a corresponding column.

The second embedded chart has the same "Score" on the y-axis, but has a different column as the x-axis.

What happens is that the first chart takes on the data from the second chart, and the second chart moves to a different location on the worksheet.

What I'd like to happen is: - Any previous charts to be deleted - Charts stay embedded and show the refreshed data - Have the charts work with the same data but not have this issue of swapping series...

Here's the code I have used:

Chart:
WS.Shapes(1).Delete


WS.Shapes.AddChart.Select

ActiveChart.ChartTitle.Text = "Acuity Scores"
WS.Shapes(1).Top = 0
WS.Shapes(1).Left = 500
WS.Shapes(1).Height = 250
WS.Shapes(1).Width = 500
ActiveChart.ChartType = xlLineMarkers
ActiveChart.PlotArea.Select



ActiveChart.SetSourceData _
Source:=WS.Range("B5:B" & WS.Range("A1000").End(xlUp).row)


With ActiveChart
    .HasTitle = True
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Protocol ID"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Acuity Score"

    .SeriesCollection(1).Name = "Acuity Score"
    .SeriesCollection(1).XValues = WS.Range("A5:A" & WS.Range("A1000").End(xlUp).row)
    .SeriesCollection(1) _
        .Trendlines.Add Type:=xlLinear, Name:="Average Acuity"
End With

Chart2:
'Worksheets("Additional Charts").Shapes(1).Delete



    With Charts.Add.Location(Where:=xlLocationAsNewSheet, Name:="Acuity vs. Tenure - " & Target)
        .ChartType = xlXYScatter
        .SetSourceData WS.Range("B5:B" & WS.Range("A1000").End(xlUp).row)
        .HasTitle = True
        .ChartTitle.Text = "Acuity vs. Tenure"

        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Text = "Acuity Score"

        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Tenure (in years)"

        .SeriesCollection(1).XValues = WS.Range("E5:E" & WS.Range("A1000").End(xlUp).row)
        .SeriesCollection(1).Name = "Acuity Scores"
        .SeriesCollection(1) _
            .Trendlines.Add Type:=xlLinear, Name:="Average Acuity"

        .ExportAsFixedFormat xlTypePDF, "C:\Desktop\AcuityVTenure.pdf"

    End With

Chart refers to the first chart that exists on the same worksheet as the filtered data. Chart2 refers to the second chart that I've had to put on a second worksheet because of the issue I mentioned above.

How do I put them on the same sheet without having the series replacement issue?

Upvotes: 0

Views: 2929

Answers (1)

HarveyFrench
HarveyFrench

Reputation: 4568

Here's some code for you to consider. It uses an object variable cht to refer to a shape on the sheet. It also uses .refresh to redraw any existing chart ont he sheet to represent the new data.

By using an object variable in this manner it is clear which object is being manipulated. Just do the same for the second chart.

Please note that I suspect you don;t need to use code to recreate them, but use code that simply refreshes them, once the data has been updated!

Dim WS As Worksheet
Dim cht As Shape

Chart:

Set WS = ActiveSheet

On Error Resume Next
    Set cht = WS.Shapes("CHART1")

    ' I think the following line makes the need to re-create the chart from scratch redundant, as this refreshes the chart!
    cht.Chart.Refresh

    cht.Delete
On Error GoTo 0


Set cht = WS.Shapes.AddChart(xlLineMarkers)

With cht

    .Name = "CHART1"
    .Title = "Acuity Scores"

    .Top = 0
    .Left = 500
    .Height = 250
    .Width = 500

End With

With cht.Chart

    '.PlotArea.Select
    .SetSourceData Source:=WS.Range("B5:B" & WS.Range("A1000").End(xlUp).Row)

    .HasTitle = True
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Protocol ID"

    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Acuity Score"

End With

With cht.Chart.SeriesCollection(1)

    .Name = "Acuity Score"
    .XValues = WS.Range("A5:A" & WS.Range("A1000").End(xlUp).Row)
    .Trendlines.Add Type:=xlLinear, Name:="Average Acuity"

End With

Upvotes: 0

Related Questions