(Solved) – Delete empty series of data from xy plot VBA


I have a vba code which adds series of data row by row based on the total number of rows of data. Based on a minimum value in one column of data, two charts are created. My skills in vba are very basic.

When I run the code, the graphs are produced but the first graph has many empty series of data added. I am unsure why this is and want to either delete them after production or stop them being added in the first place.

Sub Button6_Click()

Dim xrng As Range
Dim yrng As Range
Dim x2rng As Range
Dim y2rng As Range
Dim i As Integer
Dim Rng As Range
Dim l As Integer
Dim k As Integer
Dim i2 As Integer
Dim c As Integer
Dim j As Integer


Dim lv As String
    lv = Worksheets("Template").Range(Worksheets("Template").Range("B11"), Worksheets("Template").Range("B11").End(xlDown)).Find(WorksheetFunction.Small(Worksheets("Template").Range(Worksheets("Template").Range("B11"), Worksheets("Template").Range("B11").End(xlDown)), 1), , , 1).Address
l = ActiveCell.Row

k = Worksheets("Template").Range(Worksheets("Template").Range("B11"), Worksheets("Template").Range("B11").End(xlDown)).Rows.Count

c = l - 10

i = 1
i2 = 1
j = 1

Set xrng = Worksheets("Template").Range("C11:CP11")
Set yrng = Worksheets("Template").Range("C201:CP201")
Set x2rng = xrng.Offset(1, 0)
Set y2rng = yrng.Offset(1, 0)

Dim DownSweep As Chart
    Set DownSweep = Charts.Add

With DownSweep
        DownSweep.ChartType = xlXYScatter
        DownSweep.SeriesCollection(1).XValues = xrng
        DownSweep.SeriesCollection(1).Values = yrng
End With

i = i   1


If i < c Then

DownSweep.SeriesCollection(i).XValues = x2rng
DownSweep.SeriesCollection(i).Values = y2rng
Set x2rng = x2rng.Offset(1, 0)
Set y2rng = y2rng.Offset(1, 0)
i = i   1


End If

If i < k Then

Dim UpSweep As Chart
    Set UpSweep = Charts.Add

With UpSweep
    UpSweep.ChartType = xlXYScatter
    UpSweep.SeriesCollection(1).XValues = x2rng
    UpSweep.SeriesCollection(1).Values = y2rng
End With

End If

i = i   1
i2 = i2   1


If i < k Then

UpSweep.SeriesCollection(i2).XValues = x2rng
UpSweep.SeriesCollection(i2).Values = y2rng
Set x2rng = x2rng.Offset(1, 0)
Set y2rng = y2rng.Offset(1, 0)
i = i   1
i2 = i2   1


End If

End Sub

Any help would be appreciated,


Leave a Reply

Your email address will not be published. Required fields are marked *