View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Chris Bromley[_2_] Chris Bromley[_2_] is offline
external usenet poster
 
Posts: 6
Default Problem adding charts using Do-Loop Until loop

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 Whe=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