VB Custom Chart Creation

[waveracerr]

I have the following line of code, most of it simply copied from various
internet souces except for the line of code concerning the legend
(towards the bottom of the code, indicated with a row of dashes above
and below said line of code). The macro works great, however it is
hampered by the apparent need to still create a legend for each chart.
Basically I can physically see the macro creating a chart and adding a
legend. The macro then creates the next chart and adds a legend to the
new chart which includes the previous series. By the time the macro
has reached the last column to be charted the corresponding chart takes
forever as a legend is built to include a reference to each previous
series. Finally the code goes through each chart and removes the
legend and everything comes out fine. Ultimately I am just looking to
speed up the process by having the code never create a legend in the
first place.

Also, Any idea on how to alter the code such that the chart location is
a new worksheet rather than being placed within the current worksheet?

Thanks for any advice!

P.S. For all professors, etc. I promise I have my code properly
indented and with more descriptive comments

Option Explicit

Sub MultiX_OneY_Chart()
Dim rngDataSource As Range
Dim iDataRowsCt As Long
Dim iDataColsCt As Integer
Dim iSrsIx As Integer
Dim chtChart As CHART
Dim srsNew As Series
Dim i As Integer
i = 2
Dim j As Integer
Dim numrow As Integer
numrow = 0
Dim numcol As Integer
numcol = 0

Cells(2, 3).Select
Do While Not IsEmpty(ActiveCell)
numrow = numrow + 1
ActiveCell.Offset(1, 0).Select
Loop
numrow = numrow + 1

Cells(6, 1).Select
Do While Not IsEmpty(ActiveCell)
numcol = numcol + 1
ActiveCell.Offset(0, 1).Select
Loop

For j = 3 To numcol
If Not TypeName(Selection) = "Range" Then
' Doesn't work if no range is selected
MsgBox "Please select a data range and try again.", _
vbExclamation, "No Range Selected"
Else
Set rngDataSource = Range(Cells(1, i), Cells(numrow, j))
'Selection
With rngDataSource
iDataRowsCt = .Rows.Count
iDataColsCt = .Columns.Count
End With
' Create the chart
Set chtChart = ActiveSheet.ChartObjects.Add( _

Left:=ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + _
ActiveWindow.Width / 4, _
Width:=ActiveWindow.Width / 2, _
Top:=ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + _
ActiveWindow.Height / 4, _
Height:=ActiveWindow.Height / 2).CHART
With chtChart
For iSrsIx = 1 To iDataColsCt - 1
' Add each series
Set srsNew = .SeriesCollection.NewSeries
With srsNew
Name = rngDataSource.Cells(1, iSrsIx)
Values = rngDataSource.Cells(2, iDataColsCt)
_
Resize(iDataRowsCt - 1, 1)
XValues = rngDataSource.Cells(2, iSrsIx) _
Resize(iDataRowsCt - 1, 1)
End With
With chtChart
HasTitle = True
ChartTitle.Characters.Text = Cells(1, j)
Axes(xlCategory, xlPrimary).HasTitle = False
Axes(xlValue, xlPrimary).HasTitle = True
Axes(xlValue,
xlPrimary).AxisTitle.Characters.Text = "ug cm-3"
End With
Next
'---------------------'
With chtChart
HasLegend = False
End With
'---------------------'
End With
End If
Next j
End Sub

 

[Jon Peltier]

A few suggestions.

Put Application.ScreenUpdating=False at the top of your sub and
Application.ScreenUpdating at the bottom.

Put your Next before this block:

With chtChart
.HasTitle = True
.ChartTitle.Characters.Text = Cells(1, j)
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue,
xlPrimary).AxisTitle.Characters.Text = "ug cm-3"
End With

Put this line

If .HasLegend Then .HasLegend = False

after this one

Set srsNew = .SeriesCollection.NewSeries

and remove the bit between dashed lines. Although with screen updating
set to false, the line can go in the With chtChart loop I referenced above.

To put the chart into worksheet "My Sheet", replace Active sheet with
Worksheets("My Sheet") in the ChartObjects.Add line.

- Jon

 

[waveracerr]

Thanks for the help Jon. The only thing is that I had hoped to be abl
to assign each chart as a separate worksheet within the workbook. M
current code only places the chart as an object within the activ
workbook. I tried to replace Active sheet with
Worksheets("My Sheet") in the ChartObjects.Add line. That really onl
gave me the ability to pick which sheet to put the charts in, no
create a new sheet for each chart. Again thank you for yo
assistance!

Rya

 

[Jon Peltier]

Ryan -

To make a new chart on a chart sheet:

Change this:

Set chtChart = ActiveSheet.ChartObjects.Add( _
Left:=ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + _
ActiveWindow.Width / 4, _
Width:=ActiveWindow.Width / 2, _
Top:=ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + _
ActiveWindow.Height / 4, _
Height:=ActiveWindow.Height / 2).CHART

to this:

Set chtChart = Charts.Add

To make a new chart on a new worksheet, change that big blob to this:

Set chtChart = Worksheets.Add.ChartObjects.Add( _
Left:=ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + _
ActiveWindow.Width / 4, _
Width:=ActiveWindow.Width / 2, _
Top:=ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + _
ActiveWindow.Height / 4, _
Height:=ActiveWindow.Height / 2).CHART

- Jon