Extract from Excel graph

Thanks:  0
Likes:  0

# Thread: Extract from Excel graph

1. ## Extract from Excel graph

I have a graph with two intersecting lines. Is there any way to extract the value where the two lines cross.
Thanks

2. ## Re: Extract from Excel graph

Could you be more specific.?

Actually, when intersecting lines means, there is a data in same.!

There you can make a formula where if A2 = B2 then C2 = A2.value.

It's just a thought.

3. ## Re: Extract from Excel graph

If you have a chart with two data series, this will find all points where they intersect put them in E2:F2 downward. The header in E1 should be "X intersection" and F1 "Y intersection"

Code:
```Sub test()
Dim aVal As Variant, bVal As Variant, xVal As Variant
Dim Intersections As Variant
With ActiveSheet
With .ChartObjects.Item(1).Chart
aVal = .SeriesCollection(1).Values
bVal = .SeriesCollection(2).Values
xVal = .SeriesCollection(1).XValues
End With
End With

Intersections = ArraysIntersect(aVal, bVal, xVal)

With Range("E2")
.Resize(UBound(aVal), 2).ClearContents
.Resize(UBound(Intersections, 1), 2).Value = Intersections
End With
End Sub

Function ArraysIntersect(aArray As Variant, bArray As Variant, xArray As Variant) As Variant
Rem given xValues, Y1Values and y2Values, returns their intersections (linear interpolation)
Rem returns an array _
(n,1) xVal of intersept _
(n,2) yVal (y1 = y2) of intesect, _
(n,3) index before intersection _
(n,4) index after intersection
Dim Low As Long, High As Long
Dim i As Long, Pointer As Long
Dim Result As Variant
Dim An0 As Double, Bn0 As Double, An1 As Double, Bn1 As Double
Dim interval As Double, aSlope As Double, bSlope As Double, t As Double
Dim matchVal As Double, matchX As Double, preIndex As Long, postIndex As Long

Low = LBound(aArray): High = UBound(aArray)
Pointer = 0

ReDim Result(1 To 4, 1 To (High - Low) + 1)
Rem function returns transpose of Result

If aArray(1) = bArray(1) Then
matchVal = aArray(1)
matchX = xArray(1)
preIndex = 1: postIndex = 1
End If

For i = Low To High - 1
An0 = aArray(i): An1 = aArray(i + 1)
Bn0 = bArray(i): Bn1 = bArray(i + 1)

If An1 = Bn1 Then
Rem got one
matchVal = An1
matchX = xArray(i + 1)
preIndex = i + 1: postIndex = i + 1
Else
If ((An0 < Bn0) Xor (An1 < Bn1)) Then
Rem crossed
interval = xArray(i + 1) - xArray(i)
aSlope = (An1 - An0) / interval
bSlope = (Bn1 - Bn0) / interval
Rem since bn0 + bslope*t = an0 + aslope*t
t = (An0 - Bn0) / (bSlope - aSlope)

matchVal = An0 + (aSlope * t)
matchX = xArray(i) + (interval * t)
preIndex = i: postIndex = i + 1
End If
End If
Next i

If Pointer <> 0 Then
ReDim Preserve Result(1 To 4, 1 To Pointer)
Else
ReDim Result(1 To 4, 1 To 1)
End If

If UBound(Result, 2) = 1 Then
ReDim Result(1 To 1, 1 To 4)
Result(1, 1) = matchX
Result(1, 2) = matchVal
Result(1, 3) = preIndex
Result(1, 4) = postIndex
Else
Result = Application.Transpose(Result)
End If

ArraysIntersect = Result
Exit Function

Pointer = Pointer + 1
Result(1, Pointer) = matchX
Result(2, Pointer) = matchVal
Result(3, Pointer) = preIndex
Result(4, Pointer) = postIndex
Return
End Function```

## User Tag List

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•