intersection of two lines defined by points

[Guest]

I am looking for either a worksheet function or VBA code that would give me
the x and y coordinates of the intersection of two lines defined by points. I
have a list of x's and y's for one data set and a list of x's and y's for
another data set. I need the intersection (x and y) of these two sets of data
assuming a linear behavior between points. Your help woiuld be greatly
appreciated. Thanks!

 

[Bernie Deitrick]

Leslie,

Is the set of the X values the same, or can they be any value? Is there always an overlap of X
values within the set, or do you also need to extrapolate?

HTH,
Bernie
MS Excel MVP

 

[Bernard Liengme]

Line 1: y=m1x+c1
Line 2: y=m2x+c2

At the point of intersection the y-values of the two lines are the same as
are the x-values. So we write
m1x+c1=m2x+c2
This gives (m1-m2)x=c2-c1 or x = (m1-m2)/(c2-c1)
and
y = m1*(m1-m2)/(c2-c1) + c1
In Excel, we can find x with
=(SLOPE(y-values-dataset1,x-values-dataset1 -SLOPE(y-values-dataset2,x-values-dataset2))
/ (INTERCEPT(y-values-dataset2,x-values-dataset2) -
INTERCEPT(y-values-dataset1,x-values-dataset1))
In this is in cell G1, then we find y with
=SLOPE(y-values-dataset1,x-values-dataset1)*G1 +
INTERCEPT(y-values-dataset1,x-values-dataset1

best wishes

 

[Bernie Deitrick]

Bernard,

That's what I originally thought, too, until I noted

assuming a linear behavior between points

which I took to mean not using the entire data set for the fit.

Perhaps the OP will clarify...

Bernie

 

[Guest]

Thanks for the quick response. However, I cannot lump all data points into
one line equation. X values will be in ascending order but not all points
fall within one single line equation. And yes, I also need it to extrapolate
assuming a linear behavior of the last two points of that extrapolation
location. Example points:
x1 y1 x2 y2
1 12 1 0
3 11.8 15 8
4 10 22 10
5.2 9
9 8.9
13 8.5
20 8.4

Thanks again!

 

[Bernie Deitrick]

Leslie,

Below are two solutions. The first is a macro, written for your data table to start in cell A1 and
have headers in row 1 and matched data sets in columns A and B, and columns C and D. Columns A to D
should be otherwise empty. Use Tools / Macro / Macros... and run FindTableIntercept.

The second is a User-Defined Function, which can be used by selecting two adjacent cells, typing in
(based on your example table)

=myIntercept(A2:A8,B2:B8,C2:C4,D24)

and pressing Ctrl-Shift-Enter (array entry of the formula into both cells).

Both the macro and the function should be copied into a regular codemodule in your workbook, and
both give the solution

X = 16.57
Y = 8.45

For your example set.

I'm sure that I haven't handled all the possible ways this could go wrong - that is left as an
exercise for the reader ;-)

HTH,
Bernie
MS Excel MVP


Sub FindTableIntercept()
Dim X1Vals As Range
Dim Y1Vals As Range
Dim X2Vals As Range
Dim Y2Vals As Range
Dim i As Integer
Dim j As Integer
Dim M1 As Double
Dim M2 As Double
Dim B1 As Double
Dim B2 As Double
Dim XVal As Double
Dim YVal As Double

Set X1Vals = Range("A2", Cells(Rows.Count, 1).End(xlUp))
Set Y1Vals = Range("B2", Cells(Rows.Count, 2).End(xlUp))
Set X2Vals = Range("C2", Cells(Rows.Count, 3).End(xlUp))
Set Y2Vals = Range("D2", Cells(Rows.Count, 4).End(xlUp))

On Error GoTo ErrHandler

For i = 2 To X1Vals.Cells.Count
For j = 2 To X2Vals.Cells.Count
M1 = (Y1Vals.Cells(i).Value - Y1Vals.Cells(i - 1).Value) / _
(X1Vals.Cells(i).Value - X1Vals.Cells(i - 1).Value)
M2 = (Y2Vals.Cells(j).Value - Y2Vals.Cells(j - 1).Value) / _
(X2Vals.Cells(j).Value - X2Vals.Cells(j - 1).Value)
B1 = Y1Vals.Cells(i).Value - M1 * X1Vals.Cells(i).Value
B2 = Y2Vals.Cells(j).Value - M2 * X2Vals.Cells(j).Value
XVal = (B2 - B1) / (M1 - M2)
YVal = M1 * XVal + B1
If (XVal >= X1Vals.Cells(i - 1).Value And XVal <= X1Vals.Cells(i).Value) And _
(XVal >= X2Vals.Cells(j - 1).Value And XVal <= X2Vals.Cells(j).Value) Then
MsgBox "A solution is X = " & XVal & ", Y = " & YVal
Exit Sub
End If
Next j
Next i

MsgBox "An extrapolated solution base on the last two sets is X = " & XVal & ", Y = " & YVal
Exit Sub

ErrHandler:
MsgBox "There is an error with the data set"
End Sub


Function MyIntercept(X1Vals As Range, _
Y1Vals As Range, _
X2Vals As Range, _
Y2Vals As Range) As Variant
Dim i As Integer
Dim j As Integer
Dim M1 As Double
Dim M2 As Double
Dim B1 As Double
Dim B2 As Double
Dim XVal As Double
Dim YVal As Double
Dim mySol(1 To 2) As Double

If (X1Vals.Cells.Count <> Y1Vals.Cells.Count) Or _
(X2Vals.Cells.Count <> Y2Vals.Cells.Count) Then
MyIntercept = Array("Mismatched", "Cells")
Exit Function
End If

For i = 2 To X1Vals.Cells.Count
For j = 2 To X2Vals.Cells.Count
M1 = (Y1Vals.Cells(i).Value - Y1Vals.Cells(i - 1).Value) / _
(X1Vals.Cells(i).Value - X1Vals.Cells(i - 1).Value)
M2 = (Y2Vals.Cells(j).Value - Y2Vals.Cells(j - 1).Value) / _
(X2Vals.Cells(j).Value - X2Vals.Cells(j - 1).Value)
B1 = Y1Vals.Cells(i).Value - M1 * X1Vals.Cells(i).Value
B2 = Y2Vals.Cells(j).Value - M2 * X2Vals.Cells(j).Value
XVal = (B2 - B1) / (M1 - M2)
YVal = M1 * XVal + B1
If (XVal >= X1Vals.Cells(i - 1).Value And XVal <= X1Vals.Cells(i).Value) And _
(XVal >= X2Vals.Cells(j - 1).Value And XVal <= X2Vals.Cells(j).Value) Then
mySol(1) = XVal
mySol(2) = YVal
GoTo Output
End If
Next j
Next i

mySol(1) = XVal
mySol(2) = YVal

Output:
If Application.Caller.Rows.Count = 1 Then
MyIntercept = mySol
Else
MyIntercept = Application.Transpose(mySol)
End If


End Function

 

[Bernie Deitrick]

Well, I have found one error - due to the inaccuracies introduced by binary coding and truncation.
If there is a point shared by the two sets, the code and function may not find that obvious solution
due to the rounding introduced by calculation. To check for that, we would need to add this just
after the line Set Y2Vals = Range("D2", Cells(Rows.Count, 4).End(xlUp))

For i = 1 To X1Vals.Cells.Count
For j = 1 To X2Vals.Cells.Count
If X1Vals.Cells(i).Value = X2Vals.Cells(j).Value And _
Y1Vals.Cells(i).Value = Y2Vals.Cells(j).Value Then
MsgBox "A solution is X = " & X1Vals.Cells(i).Value & ", Y = " & Y1Vals.Cells(i).Value
Exit Sub
End If
Next j
Next i

The function would require similar code checking.

HTH,
Bernie
MS Excel MVP

 

[Guest]

Thanks so much!!

Well, I have found one error - due to the inaccuracies introduced by binary coding and truncation.
If there is a point shared by the two sets, the code and function may not find that obvious solution
due to the rounding introduced by calculation. To check for that, we would need to add this just
after the line Set Y2Vals = Range("D2", Cells(Rows.Count, 4).End(xlUp))

For i = 1 To X1Vals.Cells.Count
For j = 1 To X2Vals.Cells.Count
If X1Vals.Cells(i).Value = X2Vals.Cells(j).Value And _
Y1Vals.Cells(i).Value = Y2Vals.Cells(j).Value Then
MsgBox "A solution is X = " & X1Vals.Cells(i).Value & ", Y = " & Y1Vals.Cells(i).Value
Exit Sub
End If
Next j
Next i

The function would require similar code checking.

HTH,
Bernie
MS Excel MVP