Chart Macro?!! Help Please

J

James8309

Hi everyone

I am trying to create many many many charts and because there are so
many I am trying to create Macro to do it. Let me explain what my end
result must be and what I ve done till now.

1. I have a sheet named "$" containing all the data.
(Workbooks("Report.xls").Sheets("$")

- Dates(i.e. Jul-07 etc) are in Range("A5:AQ5") this is my X-Axis
range and this is common X-Axis for all the chart that needs to be
done

- Then I have Chart title or series lable in Columns(A:A), number of
charts or lines I have in sheets("$") changes everytime.

- Actual Y-Axis values are in $ and they are from Columns(B:AQ)

2. I just recorded one macro to give an example;

Charts.Add
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData
Source:=Sheets("$").Range("A5:AQ5,A7:AQ7"), PlotBy _
:=xlRows
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet4"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "DTF26"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With

3. End results that I need to achieve are;

- As long as Cell in Column A is not empty, Create 'Line Chart' with
X-Axis from A5:AQ5 and Y- Axis data from that particular Row (i.e. if
it is doing 8th row Chart for A8 then it will be "A5:AQ5,A8:AQ8")

- Create chart in "Sheet4"

I defined the LastRow in Column A and tried to create a simple macro
where create chart as long as A & Rowcount <> "". I keep getting
errors and my limited knowledge in VBA really makes this difficult.

Can anyone help?

Thank you in advance


Regards,


James
 
J

Joel

This will get you started. Not sure from your description if you need a
different series for each row. I also don't know where the chart title comes
from.


For Each sht In ActiveWorkbook.Sheets
Lastrow = sht.Range("A5").End(xlDown).Row
Charts.Add
Set newchart = ActiveChart
With newchart
.Activate
.ChartType = xlLine
.SetSourceData _
Source:=sht.Range("A5:AQ5,A" & Lastrow & ":AQ" & Lastrow), _
PlotBy:=xlRows
.Location Where:=xlLocationAsObject, Name:=sht.Name
.HasTitle = True
.ChartTitle.Characters.Text = "DTF26"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
Next sht
 
P

Peter T

If your series names / titles are in col-A presumably your dates are in
B5:AQ5 and your data in rows below that, ie B:AQ starting in row 6

Have a go with the following, which assumes data arranged as above

careful - note the chartobjects.delete line, comment if you don't want to
remove old charts
Change gap, W, T and X to suit

Sub BatchCharts()
Dim L As Single, T As Single, W As Single, H As Single
Dim i As Long, cnt As Long
Dim X As Long, xx As Long, lastRow As Long
Dim gap As Single
Dim co As ChartObject
Dim cht As Chart
Dim sr As Series
Dim rng As Range, cell As Range
Dim ws As Worksheet

' < change these preset options >
gap = 12 ' space between charts
W = 500 ' chart width & height
H = 200
X = 4 ' max qty of charts in a row

Set ws = ActiveWorkbook.Worksheets("Sheet1") ' change to $

Set rng = ws.Range("A6")
lastRow = rng.End(xlDown).Row
If lastRow < ws.Rows.Count Then
Set rng = rng.Resize(lastRow - rng.Row + 1, 1)
End If

ws.ChartObjects.Delete ' ????? delete previous charts ?????

L = gap
T = rng.Cells(rng.Count + 2).Top + gap

For Each cell In rng

Set cht = ws.ChartObjects.Add(L, T, W, H).Chart
With cht
.ChartArea.Font.Size = 10 ' ?
.ChartType = xlLine

Set sr = .SeriesCollection.NewSeries
sr.Name = cell.Value
sr.XValues = ws.Range("B5:AQ5")
sr.Values = cell. _
Offset(, 1) _
.Resize(, ws.Range("B5:AQ5").Columns.Count)
'.Address(, , xlR1C1)

.HasTitle = True
.ChartTitle.Text = "=" & cell.Address(, , xlR1C1, True)
'"=Sheet1!R6C1"

.HasLegend = False ' don't need it ?
End With

L = L + W + gap
xx = xx + 1
If xx = X Then
xx = 0
L = gap
T = T + H + gap
End If
Next

End Sub

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top