Graphing Macro works, but one graph always has extra series

[Centrican]

Bit of a funny one this, I've got a marco written with help from this board to produce graphs based on a large table of data. It works, all the graphs are produced, but for some reason the first graph to be created has the same number of series as there are graphs to produce.

It's not a tremendous issue as I can easily delete them again, but it's a little strange as I can't work out what in my code is asking for this to occur.

My code is below, if anyone's got any idea what's driving this (don't worry too much about fixing it, I'm more bothered about where the problem is) any feedback would be great.

Sub Test()

Dim LastRow As Long
Dim LastColumn As Integer
Dim FirstDate As Long
Dim Lastdate As Long


With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
FirstDate = 39698
'.Range("B2")
Lastdate = FirstDate + 7

End With

Const FirstRowOne As Integer = 4
Const LastRowOne As Integer = 339
Const FirstRowTwo As Integer = 52
Const LastRowTwo As Integer = 99

Dim Sh As Worksheet
Set Sh = Worksheets("Data")
Dim x As Integer
For x = 4 To LastColumn

Charts.Add

With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.Location Where:=xlLocationAsNewSheet

.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = "=" & Sh.Name & "!R" & FirstRowOne & "C2:R" & LastRowOne & "C2"
.SeriesCollection(1).Values = "=" & Sh.Name & "!R" & FirstRowOne & "C" & x & ":R" & LastRowOne & "C" & x
.SeriesCollection(1).Name = "=""Week"""
.SeriesCollection(1).AxisGroup = 1

.SeriesCollection.NewSeries
.SeriesCollection(2).XValues = "=" & Sh.Name & "!R" & FirstRowTwo & "C1:R" & LastRowTwo & "C1"
.SeriesCollection(2).Values = "=" & Sh.Name & "!R" & FirstRowTwo & "C" & x & ":R" & LastRowTwo & "C" & x
.SeriesCollection(2).Name = "=""Day"""
.SeriesCollection(2).AxisGroup = 2

.HasTitle = True
.ChartTitle.Characters.Text = Sh.Cells(2, x).Value
.HasLegend = True
.Legend.Position = xlRight
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlCategory, xlSecondary) = True
.HasAxis(xlValue, xlPrimary) = True
.HasAxis(xlValue, xlSecondary) = False

.Axes(xlCategory, xlSecondary).MinimumScale = 1
.Axes(xlCategory, xlSecondary).MaximumScale = 2
.Axes(xlCategory, xlSecondary).MinorUnitIsAuto = True
.Axes(xlCategory, xlSecondary).MajorUnit = 0.041666667
.Axes(xlCategory, xlSecondary).Crosses = xlMaximum
.Axes(xlCategory, xlSecondary).ReversePlotOrder = False
.Axes(xlCategory, xlSecondary).DisplayUnit = xlNone
.Axes(xlCategory, xlSecondary).Crosses = xlMaximum
.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat = "h:mm"
.Axes(xlCategory).MinimumScale = FirstDate
.Axes(xlCategory).MaximumScale = Lastdate
.Axes(xlCategory).MinorUnitIsAuto = True
.Axes(xlCategory).MajorUnitIsAuto = True
.Axes(xlCategory).Crosses = xlCustom
.Axes(xlCategory).CrossesAt = FirstDate
.Axes(xlCategory).ReversePlotOrder = False
.Axes(xlCategory).DisplayUnit = xlNone
.Axes(xlCategory).TickLabels.NumberFormat = "m/d/yyyy h:mm"
.SeriesCollection(2).MarkerStyle = xlNone

End With



Next x

Dim Ch As Chart
For Each Ch In ActiveWorkbook.Charts
Ch.Name = Ch.ChartTitle.Caption
Next Ch
End Sub

 

[Andrew Poulsom]

Your code appears to be adding only 2 series to each chart. To test it, please provide more information about your data, particularly the relationship of the two series as the second seems to be within the first.

 

[Jon Peltier]

If the selection is within the data range when the first chart is added, Excel is likely to use this whole range as the source data for the new chart. You can insert this right after the chart is created:

With ActiveChart
  Do Until .SeriesCollection.Count = 0
    .SeriesCollection(.SeriesCollection.Count).Delete
  Loop
End With

PS. Use "code" tags, not "quote" tags to contain your code snippets.

 

[Centrican]

Andrew: Yes the data ranges overlap; one series is a weekly electricity consumption profile, while the other is a daily one.

Jon: That looks like it's doing the trick! Excel's trying to be too clever for it's own good as usual! Cheers for that.