multiple graphs on single chart

[Alon]

Hi,
I have the following question.
I have lots of pairs of points (hundreds) and I want to
draw a line between each pair.
I can do it manually by adding each time a series but
this is a pain.

The information is organized as
X1 X2 Y1 Y2
X3 X4 Y3 Y4
....
And the lines should be between (X1,Y1) and (X2,Y2)
and a snother line between (X3,Y3) and (X4,Y4) and so on.

Any ideas how to do it automatically?

Thanks! Alon

 

[Dave Ramage]

Alon,

Here's a macro that will do it in (almost) a flash!
Start the macro, then select the range of data.

Sub Draw_XY_Lines()
'draws xy chart and adds single lines defined from:
'x1 x2 y1 y2
'x3 x4 y3 y4
'etc
'lines drawn between (x1,y1) and (x2,y2) etc

Dim rngSource As Range
Dim r As Range
Dim c As Chart
Dim s As Series

On Error Resume Next
Set rngSource = Application.InputBox( _
prompt:="Select source points:", _
Type:=8)
On Error GoTo 0
If rngSource Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Set c = ActiveWorkbook.Charts.Add
c.ChartType = xlXYScatterLinesNoMarkers
c.HasLegend = False

For Each r In rngSource.Rows
Set s = c.SeriesCollection.NewSeries
With s
.XValues = Range(r.Cells(1), r.Cells(2))
.Values = Range(r.Cells(3), r.Cells(4))
End With
With s.Border
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With
Next r
Application.ScreenUpdating = True
End Sub

Cheers,
Dave

 

[Guest]

Thanks!!!
Worked in a flash.
Alon

-----Original Message-----
Alon,

Here's a macro that will do it in (almost) a flash!
Start the macro, then select the range of data.

Sub Draw_XY_Lines()
'draws xy chart and adds single lines defined from:
'x1 x2 y1 y2
'x3 x4 y3 y4
'etc
'lines drawn between (x1,y1) and (x2,y2) etc

Dim rngSource As Range
Dim r As Range
Dim c As Chart
Dim s As Series

On Error Resume Next
Set rngSource = Application.InputBox( _
prompt:="Select source points:", _
Type:=8)
On Error GoTo 0
If rngSource Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Set c = ActiveWorkbook.Charts.Add
c.ChartType = xlXYScatterLinesNoMarkers
c.HasLegend = False

For Each r In rngSource.Rows
Set s = c.SeriesCollection.NewSeries
With s
.XValues = Range(r.Cells(1), r.Cells(2))
.Values = Range(r.Cells(3), r.Cells(4))
End With
With s.Border
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With
Next r
Application.ScreenUpdating = True
End Sub

Cheers,
Dave
.