VBA to generate XY Scatter Plot

Viewed 19

I have a dynamic spreadsheet that a user adds data in everyday. Once the user runs a report a macro moves data from the input page to a log page and some of the calculated data from the log page is moved to a different worksheet so it can be used to produce an XY scatter plot. I have 3 XY scatter plots from different data sets that are generated via the VBA below. The VBA produces a chart sheet with two buttons 1)Prints PDF 2) Returns to the previous page and deletes the chart. Periodically when running the macro to produce the graph Excel will crash. In addition, randomly the macro produced graph will be scrambled meaning the Legend will not be correct and the X/Y axis will be incorrect. This only happens about 30% of the time, but it's extremely random. Why would Excel be crashing and scrambling the plot randomly? Does it have something do with the chart being deleted each time? Is there a better way to generate these graphs, such as creating the Chart sheet and using the Macro to update the graph? If so, how would the code be different to accomplish this task? Thanks in advance for all your time and help.

Sub SalesMigration()

    Dim LastRow As Long
    Dim Rng1 As Range
    Dim rng2 As Range
    Dim ShName As String
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Tables")
    LastRow = getLastRow(ThisWorkbook.Worksheets("Tables"), 6)
        Set Rng1 = .Range("F1:F" & LastRow & ", G1:G" & LastRow & ", H1:H" & LastRow & ", I1:I" & LastRow)
    End With
    Charts.Add Before:=ThisWorkbook.Worksheets(Worksheets.Count)
    With ActiveChart
        .ChartType = xlXYScatterLines
        .SetSourceData Source:=Rng1
        .HasTitle = True
        .ChartTitle.Text = "Sales and Inventory Data"
        .HasLegend = True
        .Legend.Position = xlLegendPositionBottom
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Sales & Inventory"
        .PlotArea.Interior.Color = RGB(192, 192, 192)
        With .SeriesCollection(1)
            .Format.Line.ForeColor.RGB = RGB(255, 0, 255)
            .Format.Fill.ForeColor.RGB = RGB(255, 0, 255)
        End With
        With .SeriesCollection(2)
            .Format.Line.ForeColor.RGB = RGB(0, 0, 255)
            .Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
        End With
        With .SeriesCollection(3)
            .Format.Line.ForeColor.RGB = RGB(255, 255, 0)
            .Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
        End With
        
    End With
    
ActiveSheet.Buttons.Add(900, 115, 100, 50).Select
With Selection
.OnAction = "Delete"
.Characters.Text = "RETURN"
End With

ActiveChart.Name = "Sales & Inventory"

ActiveSheet.Buttons.Add(900, 50, 100, 50).Select
With Selection
.OnAction = "PrintGraphs"
.Characters.Text = "PRINT"
End With

ActiveChart.Protect Password:="Sales2022"
Application.ScreenUpdating = True

Here is the code to return and delete the chart.

Sub Delete()
Application.ScreenUpdating = False
On Error Resume Next
ThisWorkbook.Worksheets("Tables").Select
Application.DisplayAlerts = False
On Error Resume Next
Charts.Delete
Application.ScreenUpdating = True
End Sub 

The getLastRow is a function for finding the last row a very kind person from this platform helped me with previously.

0 Answers
Related