Extract from Excel graph

Jeffrey040

New Member
Joined
May 17, 2009
Messages
11
I have a graph with two intersecting lines. Is there any way to extract the value where the two lines cross.
Thanks
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
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.
 
Upvote 0
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
        GoSub addOne
    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
            GoSub addOne
        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
                GoSub addOne
            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

addOne:
    Pointer = Pointer + 1
    Result(1, Pointer) = matchX
    Result(2, Pointer) = matchVal
    Result(3, Pointer) = preIndex
    Result(4, Pointer) = postIndex
    Return
End Function
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top