Trendline coefficient extraction code

Option Explicit
Option Base 0
'Function TLcoef(...) returns Trendline coefficients
'Function TLeval(x, ...) evaluates the current trendline at a given x
'
'The arguments of TLcoef, and the last 4 of TLeval: _
    vSheet is the name/number of the sheet containing the chart. _
        Use of the name (as in the Sheet's tab) is recommended _
    vCht is the name/number of the chart. To see this, deselect _
        the chart, then shift-click it; its name will appear in the _
        drop-down list at the left of formula bar.  In the case of a _
        chart in its own chartsheet, specify this as zero or the zero _
        length string "" _
    VSeries is a series name/number, and vTL is the series' trendline _
        number. If the series has a name, it is probably better to _
        specify the name. To determine the name/number, as well as _
        the trendline number needed for vTL, pass the mouse arrow _
        over the trendline. Of course, if there is only one series in _
        the chart, you can set vSeries = 1, but beware if you add _
        more series to the chart.
 
'First draft written 2003 March 1 by D J Braden _
Revisions by Tushar Mehta (www.tushar-mehta.com) 2005 Jun 19: _
    Various documentation changes _
    vCht is now 'optional' _
    Correctly handles cases where a term is missing -- e.g., _
        y = 2x3 + 3x + 10 _
    Correctly handles cases where a coefficient is not shown because _
        it is the default value -- e.g., y = Ln(x)+10 _
    When only the constant term is present, the original function _
        returned it in the correct array element only for the _
        polynomial and linear fits. Now, the function returns it in _
        the correct array element for other types also.  For example, _
        for an exponential fit, y=10 will be returned as (10,0) _
    Arrays are now base zero.
'Limitations: _
    The coefficients are returned to precision *displayed* _
        To get the most accurate values, format the trendline label _
        to scientific notation with 14 decimal places. (Right-click _
        the label to do this) _
    Given how XL calculation engine works -- recalculates the _
        worksheet first, then the chart(s) -- it is eminently _
        possible for the chart to show one trendline and the _
        function to return coefficients corresponding to the values _
        shown by the chart *prior* to the recalculation.  To see the _
        effect of this '1 recalculation cycle lag' plot a series of _
        random numbers. _
    An alternative to the functions in this module is the LINEST _
        worksheet function.  Except for those few cases where LINEST _
        returns incorrect results, it is the more robust function _
        since it doesn't suffer from the '1 recalculation cycle' _
        lag.  With XL2003 LINEST may even return more accurate _
        results than the trendline.
 
Function TLcoef(vSheet, vCht, vSeries, vTL)
    'To get the coefficients of a chart on a chartsheet, specify vCht _
     as zero or the zero length string ""
 
    'Return coefficients of an Excel chart trendline. _
     Limitations: See the documentation at the top of the module _
    'Note: For a polynomial fit, it is possible the trendline doesn't _
     report all the terms.  So this function returns an array of _
     length (1 + the order of the requested fit), *not* the number of _
     values displayed.  The last value in the returned array is the _
     constant term; preceeding values correspond to higher-order x.
    Dim o As Trendline
    Application.Volatile
    If ParamErr(TLcoef, vSheet, vCht, vSeries, vTL) Then Exit Function
    On Error Resume Next
    If vCht = "" Or vCht = 0 Then
        If TypeOf Sheets(vSheet) Is Chart Then
            Set o = Sheets(vSheet).SeriesCollection(vSeries) _
                .Trendlines(vTL)

        Else
            TLcoef = "#Err: vCht can be omitted only if vSheet is a " _
                & "chartsheet"
            Exit Function   '*****
            End If
    Else
        Set o = Sheets(vSheet).ChartObjects(vCht).Chart. _
            SeriesCollection(vSeries).Trendlines(vTL)
        End If
    On Error GoTo 0
    If o Is Nothing Then
        TLcoef = "#Err: No trendline matches the specified parameters"
    Else
        TLcoef = ExtractCoef(o)
    End If
    End Function
 
Function TLeval(vX, vSheet, vCht, vSeries, vTL)
    'DJ Braden
    'Exp/logs are done for cases xlPower and xlExponential to _
     allow for greater range of arguments.
    Dim o As Trendline, vRet
 
    Application.Volatile
    If ParamErr(TLeval, vSheet, vCht, vSeries, vTL) Then Exit Function
    On Error Resume Next
    If vCht = "" Or vCht = 0 Then
        If TypeOf Sheets(vSheet) Is Chart Then
            Set o = Sheets(vSheet).SeriesCollection(vSeries) _
                .Trendlines(vTL)
        Else
            TLeval = "#Err: vCht can be omitted only if vSheet is a " _
                & "chartsheet"
            Exit Function   '*****
            End If
    Else
        Set o = Sheets(vSheet).ChartObjects(vCht).Chart. _
            SeriesCollection(vSeries).Trendlines(vTL)
        End If
    On Error GoTo 0
    If o Is Nothing Then
        TLeval = "#Err: No trendline matches the specified parameters"
        Exit Function
        End If
    vRet = ExtractCoef(o)
    If TypeName(vRet) = "String" Then TLeval = vRet: Exit Function
    Select Case o.Type
    Case xlLinear
        TLeval = vX * vRet(LBound(vRet)) + vRet(UBound(vRet))
    Case xlExponential 'see comment above
        TLeval = Exp(Log(vRet(LBound(vRet))) + vX * vRet(UBound(vRet)))
    Case xlLogarithmic
        TLeval = vRet(LBound(vRet)) * Log(vX) + vRet(UBound(vRet))
    Case xlPower 'see comment above
        TLeval = Exp(Log(vRet(LBound(vRet))) _
            + Log(vX) * vRet(UBound(vRet)))
    Case xlPolynomial
        Dim Idx As Long
        TLeval = vRet(LBound(vRet)) * vX + vRet(LBound(vRet) + 1)
        For Idx = LBound(vRet) + 2 To UBound(vRet)
            TLeval = vX * TLeval + vRet(Idx)
            Next Idx
        End Select
    End Function
 

    Private Function DecodeOneTerm(ByVal TLText As String, _
            ByVal SearchToken As String, _
            ByVal UnspecifiedConstant As Byte)
        'splits {optional number}{SearchToken} _
            {optional numeric constant}
        Dim v(1) As Double, TokenLoc As Long
        TokenLoc = InStr(1, TLText, SearchToken, vbTextCompare)
        If TokenLoc = 0 Then
            v(1) = CDbl(TLText)
        Else
            If TokenLoc = 1 Then v(0) = 1 _
            Else v(0) = Left(TLText, TokenLoc - 1)
            If TokenLoc + Len(SearchToken) > Len(TLText) Then _
                v(1) = UnspecifiedConstant _
            Else v(1) = Mid(TLText, TokenLoc + Len(SearchToken))
            End If
        DecodeOneTerm = v
        End Function

    Private Function getXPower(ByVal TLText As String, _
            ByVal XPos As Long)
        If XPos = Len(TLText) Then
            getXPower = 1
        ElseIf IsNumeric(Mid(TLText, XPos + 1, 1)) Then
            getXPower = Mid(TLText, XPos + 1, 1)
        Else
            getXPower = 1
            End If
        End Function
 
Private Function ExtractCoef(o As Trendline)
    Dim XPos As Long, s As String
    On Error Resume Next
    s = o.DataLabel.Text
    On Error GoTo 0
    If s = "" Then
        ExtractCoef = "#Err: No trendline equation found"
        Exit Function       '*****
        End If
    If o.DisplayRSquared Then s = Left$(s, InStr(s, "R") - 2)
    s = Trim(Mid(s, InStr(1, s, "=", vbTextCompare) + 1))
    Select Case o.Type
    Case xlMovingAvg
    Case xlLogarithmic
        ExtractCoef = DecodeOneTerm(s, "Ln(x)", 0)
    Case xlLinear
        ExtractCoef = DecodeOneTerm(s, "x", 0)
    Case xlExponential
        s = Application.WorksheetFunction.Substitute(s, "x", "")
        ExtractCoef = DecodeOneTerm(s, "e", 1)
    Case xlPower
        ExtractCoef = DecodeOneTerm(s, "x", 1)
    Case xlPolynomial
        Dim lOrd As Long
        ReDim v(o.Order) As Double
        s = Application.WorksheetFunction.Substitute(s, " ", "")
        s = Application.WorksheetFunction.Substitute(s, "+x", "+1x")
        s = Application.WorksheetFunction.Substitute(s, "-x", "-1x")
        Do While s <> ""
            XPos = InStr(1, s, "x")
            If XPos = 0 Then
                v(o.Order) = s 'constant term
                s = ""
            Else
                lOrd = getXPower(s, XPos)
                If XPos = 1 Then v(UBound(v) - lOrd) = 1 _
                Else _
                    v(UBound(v) - lOrd) = Left(s, XPos - 1)
                If XPos = Len(s) Then
                    s = ""
                ElseIf IsNumeric(Mid(s, XPos + 1, 1)) Then
                    s = Trim(Mid(s, XPos + 2))
                Else

                   s = Trim(Mid(s, XPos + 1))
                    End If
                End If
            Loop
        ExtractCoef = v
        End Select
    End Function

Private Function ParamErr(v, ParamArray parms())
    Dim l As Long
    For l = LBound(parms) To UBound(parms)
        If VarType(parms(l)) = vbError Then
            v = parms(l)
            ParamErr = True
            Exit Function
            End If
        Next l
    End Function