Results 1 to 3 of 3

Extract from Excel graph

This is a discussion on Extract from Excel graph within the Excel Questions forums, part of the Question Forums category; I have a graph with two intersecting lines. Is there any way to extract the value where the two lines ...

  1. #1
    New Member
    Join Date
    May 2009
    Posts
    11

    Default 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. #2
    Board Regular krishhi's Avatar
    Join Date
    Sep 2008
    Posts
    327

    Default 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.
    Happiness keeps u sweet, trials keep u strong, sorrow keeps u human, failure keeps u humble, success keeps u glowing, but only God keeps u going


  3. #3
    MrExcel MVP mikerickson's Avatar
    Join Date
    Jan 2007
    Location
    Davis CA
    Posts
    16,681

    Default 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
            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

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com