Chart Macro?!! Help Please

  • Thread starter Thread starter James8309
  • Start date Start date
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
 
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
 
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
 
Back
Top