Problem adding charts using Do-Loop Until loop

[Chris Bromley]

Hi All,

I've written a macro (code below) to create a series of XY scatter charts in
the same workbook. The first time through the loop, everything works exactly
as it should and I get the desired graph. The second time through, the
Charts.Add command adds a chart sheet but doesn't add a chart - I just have a
blank white space. When the code gets to the 'ActiveChart.HasTitle = True'
line the following error appears:Run-time error '1004' Method 'HasTitle'
of object '_Chart' failed.

I've got absolutely no idea what might be causing this problem and any help
would be greatly appreciated!

Regards,

--
Chris

Sub Armour_Subarmour_GSD_Plots()
'Before starting the macro set the Activecell to "A1"

'Application.ScreenUpdating = False

'Set the row and column indices to cell D11
RI = 11
CI = 5

Do
'Set the name of the chart
ChartName = ActiveCell.Value & " " & ActiveCell.Offset(2, 1).Value _
& "m plot"

'Set the names of the armour & sub-armour data series
If IsEmpty(ActiveCell.Offset(3, 1)) And _
ActiveCell.Offset(4, 1).Value = "Armour" Then
Series1Name = ActiveCell.Offset(2, 1).Value & "m Armour"
Series2Name = ActiveCell.Offset(2, 1).Value & _
"m Sub-armour"
End If

'Create a new XY scatter plot as a new chart sheet
Charts.Add
ActiveChart.Location Where:=xlLocationAsNewSheet, _
Name:=ChartName
ActiveChart.ChartType = xlXYScatterLines

'Set the formatting for all chart elements

'Set all chart title formatting
ActiveChart.HasTitle = True
With ActiveChart.ChartTitle
.Characters.Text = "Grain Size Distribution"
.Font.Size = 16
.Font.Bold = True
End With

'Set all X-axis formatting
With ActiveChart.Axes(xlCategory, xlPrimary)
ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Select
With Selection
.Characters.Text = "Grain Size (mm)"
.Font.Size = 12
.Font.Bold = True
End With
.MinimumScale = 0.01
.MaximumScale = 100
.Crosses = xlCustom
.CrossesAt = 0.01
.ScaleType = xlLogarithmic
.HasMajorGridlines = True
.HasMinorGridlines = True
.DisplayUnit = xlNone
ActiveChart.Axes(xlCategory, xlPrimary).Select
With Selection.TickLabels
.Font.Size = 10
.Font.Bold = True
End With
With Selection
.MinorTickMark = xlOutside
End With
End With

'Set all Y-axis formatting
With ActiveChart.Axes(xlValue, xlPrimary)
ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Select
With Selection
.Characters.Text = "Percent finer than"
.Font.Size = 12
.Font.Bold = True
End With
.MinimumScale = 0
.MaximumScale = 100
.MinorUnit = 2
.MajorUnit = 10
ActiveChart.Axes(xlValue, xlPrimary).Select
With Selection.TickLabels
.Font.Size = 10
.Font.Bold = True
.NumberFormat = "0"
End With
With Selection
.MinorTickMark = xlOutside
End With
End With

'Set all Legend formatting & re-adjust plot area
With ActiveChart.Legend
.Left = 490
.Top = 327
.Width = 160
.Height = 58
.Font.Bold = True
End With
ActiveChart.PlotArea.Select
Selection.Width = 645

Worksheets("Run11").Activate

'Adds the Armour and Sub-armour data series to the same chart
If ActiveCell.Offset(4, 1).Value = "Armour" Then

Charts(ChartName).Activate

'Add series 1 (Armour or Surface) data to the chart
With ActiveChart.SeriesCollection(1)
.XValues = Worksheets("Run11").Range("B11:B24")
.Values = Worksheets("Run11").Range(Worksheets("Run11") _
.Cells(RI, CI), Worksheets("Run11").Cells _
(RI + 13, CI))
.Name = Series1Name
End With

'Add series 2 (Sub-armour or Sub-surface) and its
'data to the chart
ActiveChart.SeriesCollection.NewSeries
With ActiveChart.SeriesCollection(2)
.XValues = Worksheets("Run11").Range("B11:B24")
.Values = Worksheets("Run11").Range(Worksheets("Run11") _
.Cells(RI, CI + 11), Worksheets("Run11").Cells _
(RI + 13, CI + 11))
.Name = Series2Name
End With
End If

Worksheets("Run11").Activate

'Adds all the Bulk data series to the same chart
If ActiveCell.Offset(4, 1).Value = "Bulk" Then
i = 0
Do
Charts(ChartName).Activate
i = i + 1
With ActiveChart.SeriesCollection(i)
.XValues = Worksheets("Run11").Range("B11:B24")
.Values = Worksheets("Run11").Range(Worksheets("Run11") _
.Cells(RI, CI), Worksheets("Run11").Cells _
(RI + 13, CI))
.Name = ActiveCell.Offset(2, 1).Value & " " & _
ActiveCell.Offset(4, 1).Value
End With
Worksheets("Run11").Activate
If ActiveCell.Offset(4, 12).Value = "Bulk" Then
Charts(ChartName).Activate
ActiveChart.SeriesCollection.NewSeries
Worksheets("Run11").Activate
ActiveCell.Offset(0, 11).Select
End If
Loop While ActiveCell.Offset(4, 1).Value = "Bulk"
End If

'Update the column Index and ActiveCell locations
If ActiveCell.Offset(4, 1).Value = "Armour" And _
ActiveCell.Offset(4, 23).Value = "Armour" Then
CI = CI + 22
Worksheets("Run11").Activate
ActiveCell.Offset(0, 22).Select
End If

If ActiveCell.Offset(4, 1).Value = "Armour" And _
IsEmpty(ActiveCell.Offset(4, 23)) Then
Worksheets("Run11").Activate
ActiveCell.Offset(0, 22).Select
End If

If ActiveCell.Offset(4, 1).Value = "Armour" And _
ActiveCell.Offset(4, 23).Value = "Bulk" Then
CI = CI + 22
Worksheets("Run11").Activate
ActiveCell.Offset(0, 22).Select
End If

If ActiveCell.Offset(4, 1).Value = "Bulk" And _
ActiveCell.Offset(4, 23).Value = "Bulk" Then
CI = CI + 11
Worksheets("Run11").Activate
ActiveCell.Offset(0, 11).Select
End If

If ActiveCell.Offset(4, 1).Value = "Bulk" And _
IsEmpty(ActiveCell.Offset(4, 12)) Then
Worksheets("Run11").Activate
ActiveCell.Offset(0, 22).Select
End If

'Tell the code what to do if all the samples from that
'sampling interval have been processed
If IsEmpty(ActiveCell.Offset(4, 1)) Then
ActiveCell.Offset(40, 0).Select
ActiveCell.End(xlToLeft).Select
RI = RI + 40
CI = 5
End If

Loop Until IsEmpty(ActiveCell.Offset(4, 1))

End Sub

 

[Greg Wilson]

Chris,

I had a look at your post earlier but gave up trying to figure out what you
were trying to do. IMHO, the problem is that the code is very long and there
is a lot of selecting and offseting going on and we have to infur what is
happening without having any idea how the worksheets are strucured. There is
also a lot of inefficiency in the code and it really needs a major revamp.

Since at this point it seems unlikely that anyone will respond, suggested is
that you provide a simplified version of the worksheet layout as well as a
description of what it is you are trying to do. Keep it simple. Expect
responders to only provide the required code structure and adapt it to suit.
And don't expect responders to supply all the chart formatting detail. Flesh
it out yourself. This is just my own opinion granted.

Best regards,
Greg

 

[Chris Bromley]

Hi Greg,

Thanks very much for replying. I was wondering at the back of my mind when I
posted this whether or not the length of the code would put people off, so
thanks very much for taking the time and trouble to try and decipher it.

Fortunately, I've managed to solve the problem. I was doing more research
online this morning and by chance came across a comment from Jon Peltier.
Apparently, when the Charts.Add command adds a new chart sheet to a workbook
it sometimes adds an empty series to it, thus making the standard empty chart
area appear, and sometimes it doesn't, hence just leaving the white space of
the chart sheet. So first time through the Do-While loop the former was
occurring and second time through the latter was occurring. The solution is
to add the following immediately below the Charts.Add command:

If ActiveChart.SeriesCollection.Count = 0 Then
ActiveChart.SeriesCollection.NewSeries
End If

The way the macro adds series to the charts depends on a number of factors
related to the nature of the data being plotted and the way the data
worksheet is set up. The worksheet isn't terribly simple and, since I'm
pretty new to VBA, this was the only way I could come up with to give the
code the necessary 'decision-making' capabilities. However, I'd love to know
how to improve the efficiency of my coding, so do you have any general
pointers on sections of code that I should be looking to improve?

Cheers,

Chris