Code Post: Extract Trendline coefficients

5852 views
Skip to first unread message

David J. Braden

unread,
Mar 5, 2003, 2:05:47 PM3/5/03
to
I'm getting a fair number of requests for the following code; seems
approriate, in my circumstances, to post it.

HTH
Dave Braden

=========

Option Explicit

'As J.W. Lewis has noted, Excel's Chart Trendline function yields
'exceptionally good values for the models it fits. In contrast to
'Excel's overall stats-capability, Trendline is a standout.
'
'These functions provide a quasi-dynamic link to a chart's *displayed*
'trendline to help avoid deficencies of Excel's LINEST.
'
'Function TLcoef(...) returns Trendline coefficients
'Function TLeval(x, ...) evaluates the current trendline at a given x
'
'To specify the arguments of TLcoef, and the last 4 of TLeval:
' vSheet is the name/number of the sheet containing the chart.
' I strongly recommend you use the text name appearing in the
sheet's tab
' 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
' the standard toolbar.
' If there is only one chart in the sheet, you can safely use just 1
as an
' argument.
' VSeries is a series name/number, and vTL is the series' trendline
number.
' Ideally you will have named the series, and refer to it by name.
' To determine its 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.
'
'David J. Braden maintains this as an open-community effort. Plz post
or send
' suggestions to him.

'First draft written 2003 March 1 by D J Braden

'Current concern(s)
' (1) Because this is a function, we can't reliably get the underlying
trendline
' coefficients to greater accuracy than what is 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)
' (2) Even though the functions are volatile, you may have to do a
worksheet
' recalc to get things updated properly for anything changing the
chart to
' get passed through to these functions. :((

'********************************************************

Const cFirstNumPos = 5 ' pos. of first integer in displayed eqn
Const cMaxFormat = "0.00000000000000E+00"

Function TLcoef(vSheet, vCht, vSeries, vTL)

'Return coefficients of an Excel chart trendline, *to precision
displayed*
'
'Note: While Trendline seemingly always reports subsequent terms from
'a given one on, sometimes it reduces the order of the fit. So this
function
'returns, for a poly-fit, an array of length 1 + the order of the
requested fit,
' *not* the number of values displayed. The last value in the return
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 GoTo HanErr
Set o = Sheets(vSheet).ChartObjects(vCht).Chart. _
SeriesCollection(vSeries).Trendlines(vTL)
TLcoef = ExtractCoef(o, cFirstNumPos)
Exit Function

HanErr:
TLcoef = CVErr(xlErrValue)
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 Not CheckNum(vX, TLeval) Then Exit Function
If ParamErr(TLeval, vSheet, vCht, vSeries, vTL) Then Exit Function

Set o =
Sheets(vSheet).ChartObjects(vCht).Chart.SeriesCollection(vSeries) _
.Trendlines(vTL)

vRet = ExtractCoef(o, cFirstNumPos)
Select Case o.Type
Case xlLinear
vRet(1) = vX * vRet(1) + vRet(2)
Case xlExponential 'see comment above
vRet(1) = Exp(Log(vRet(1)) + vX * vRet(2))
Case xlLogarithmic
vRet(1) = vRet(1) * Log(vX) + vRet(2)
Case xlPower 'see comment above
vRet(1) = Exp(Log(vRet(1)) + Log(vX) * vRet(2))
Case xlPolynomial
Dim l As Long
vRet(1) = vRet(1) * vX + vRet(2)
For l = 3 To UBound(vRet)
vRet(1) = vX * vRet(1) + vRet(l)
Next
End Select
TLeval = vRet(1)
Exit Function

HanErr:
TLeval = CVErr(xlErrValue)
End Function


Private Function ExtractCoef(o As Trendline, ByVal lLastPos As Long)
Dim lCurPos As Long, s As String

s = o.DataLabel.Text

If o.DisplayRSquared Then
lCurPos = InStr(s, "R")
s = Left$(s, lCurPos - 1)
End If

If o.Type <> xlPolynomial Then
ReDim v(1 To 2) As Double

If o.Type = xlExponential Then
s = Application.WorksheetFunction.Substitute(s, "x", "")
s = Application.WorksheetFunction.Substitute(s, "e", "x")
ElseIf o.Type = xlLogarithmic Then
s = Application.WorksheetFunction.Substitute(s, "Ln(x)", "x")
End If

lCurPos = InStr(1, s, "x")
If lCurPos = 0 Then
v(2) = Mid(s, lLastPos)
Else
v(1) = Mid(s, lLastPos, lCurPos - lLastPos)
v(2) = Mid(s, lCurPos + 1)
End If

Else 'have a polynomial
Dim lOrd As Long
ReDim v(1 To o.Order + 1) As Double

lCurPos = InStr(s, "x")
If lCurPos = 0 Then
v(o.Order + 1) = Mid(s, lLastPos)
Exit Function 'with single constant term
End If
'else
lOrd = Mid(s, lCurPos + 1, 1)
Do While lOrd > 1
v(UBound(v) - lOrd) = Mid(s, lLastPos, lCurPos - lLastPos)
lLastPos = lCurPos + 2
lCurPos = InStr(lLastPos, s, "x")
lOrd = lOrd - 1
Loop
'peel off coeffs. for affine terms in eqn
v(o.Order) = Mid(s, lLastPos, lCurPos - lLastPos)
v(o.Order + 1) = Mid(s, lCurPos + 1)
End If
ExtractCoef = v
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
End Function

--
ROT13 e-mail: qoe...@ebpurfgre.ee.pbz

who

unread,
Jan 10, 2005, 1:47:13 PM1/10/05
to
Hi Dave,
My name is Dave also. Hope you are having a good day. I am trying to
accomplish a task in Excel and was referred here and to you by Ron
Rosenfeld, while using the Excel Programming News Group. First I will
thank you for your time and efforts, which when I look at what you have
done is already considerable. Then I will confess that it has been a
long time since I studied stats.
I have what is a fairly simple set of data, a Date and an Adj Close*,
which is data assocated with the Dow Jones Averages. The data looks
like this:
Date Adj. Close*
01/03/05 10729.43
12/27/04 10776.13
12/20/04 10661.6
......More data
The data is graphed and a 6th Degree Polynomial Trend line is added to
the chart.
What I am trying to do is add to the data set is a data point
associated with the 6th Degree Polynomial Trend line, so the data would
look something like this:
Date Adj. Close* Trend
01/03/05 10729.43 10750.20(these are guesses, just for example,
but what I am trying to calculate)
12/27/04 10776.13 10751.23
12/20/04 10661.6 10680.00
......More data
Like I said, it has been a long time since I have studied stats. I
don't know that it is possible to do this, but it seems that creating a
table that caculates the trend number for the particular Date and Adj.
Close would be possible. I have tried several of the Excel functions
but do not get numbers that approximate the "Trend Numbers." I have
tried:
=LINEST(A2:A314,B2:B314) and get: -.2682
then the formula supplied with the chart:
y = -6E-11^6 + 1E-05^5 - 1.2819^4 + 65247^3 - 2E+09^2 + 3E+13x - 2E+17
and I get some thing like
-445,236,000,000,000,000
I also tried Forecast and Trend, neither of which came close to what
the Trend Line indicated as reasonable. I am at a loss. If you have the
time to shed some light on this, I would appreciate it.

It looks like your function:


Function TLeval(vX, vSheet, vCht, vSeries, vTL)

might do what I am thinking of, but I am not certain. It looks like
part of the code got cut off. I tried to copy it over to word and
figure out what arguments it needs and stuff, but I have not been able
to get through it. Thanks for your time and effort, I hope you have a
good day.

Sincerely,
David Lanman
who...@sbcglobal.net

who

unread,
Jan 10, 2005, 1:49:51 PM1/10/05
to
Sorry but I forgot to mention that I am new to Google Groups and just
got a user name, etc., so I anot even ceratin I can get back to this
spot. I did save it to my favorites.

Thanks again

Dave Peterson

unread,
Jan 10, 2005, 6:36:35 PM1/10/05
to
There are a lot of Dave's who hang around these groups.

Dave Braden is one:
http://google.co.uk/groups?threadm=dbraden-1C662A.14054705032003%40msnews.microsoft.com
(one line in your browser)

Maybe this is the Dave you were looking for.

--

Dave Peterson

sdr...@dfrsrainbow.com

unread,
Nov 16, 2017, 11:21:31 PM11/16/17
to
I took your code and came up with the following and it seems not to work for me
Const cFirstNumPos = 5 ' pos. of first integer in displayed eqn
Const cMaxFormat = "0.00000000000000E+00"
Sub DetermineTrendlineCoefficients()
Dim vSheet
Dim vSeries
Dim vTL
Dim vCht
vSheet = "CONTROLROOM"
vCht = 29
vSeries = "EnergyVector"
vTL = "S&P" & " Trendline 1"

A = TLcoef(vSheet, vCht, vSeries, vTL)

End Sub
Function TLcoef(vSheet, vCht, vSeries, vTL)
Dim o As Trendline
Application.Volatile
If ParamErr(TLcoef, vSheet, vCht, vSeries, vTL) Then Exit Function
On Error GoTo HanErr
Set o = Sheets(vSheet).ChartObjects(vCht).Chart. _
SeriesCollection(vSeries).Trendlines(vTL)
TLcoef = ExtractCoef(o, cFirstNumPos)
HanErr:
TLcoef = CVErr(xlErrValue)
MsgBox TLcoef
End Function

Function TLeval(vX, vSheet, vCht, vSeries, vTL)
Dim o As Trendline, vRet

Application.Volatile
Function ExtractCoef(o As Trendline, ByVal lLastPos As Long)
Dim lCurPos As Long, s As String

s = o.DataLabel.Text

If o.DisplayRSquared Then
lCurPos = InStr(s, "R")
s = Left$(s, lCurPos - 1)
End If

If o.Type <> xlPolynomial Then
ReDim v(1 To 2) As Double

If o.Type = xlExponential Then
s = Application.WorksheetFunction.Substitute(s, "x", "")
s = Application.WorksheetFunction.Substitute(s, "e", "x")
ElseIf o.Type = xlLogarithmic Then
s = Application.WorksheetFunction.Substitute(s, "Ln(x)", "x")
End If

lCurPos = InStr(1, s, "x")
If lCurPos = 0 Then
v(2) = Mid(s, lLastPos)
Else
v(1) = Mid(s, lLastPos, lCurPos - lLastPos)
v(2) = Mid(s, lCurPos + 1)
End If

Else 'have a polynomial
Dim lOrd As Long
ReDim v(1 To o.order + 1) As Double

lCurPos = InStr(s, "x")
If lCurPos = 0 Then
v(o.order + 1) = Mid(s, lLastPos)
Exit Function 'with single constant term
End If
'else
lOrd = Mid(s, lCurPos + 1, 1)
Do While lOrd > 1
v(UBound(v) - lOrd) = Mid(s, lLastPos, lCurPos - lLastPos)
lLastPos = lCurPos + 2
lCurPos = InStr(lLastPos, s, "x")
lOrd = lOrd - 1
Loop
'peel off coeffs. for affine terms in eqn
v(o.order) = Mid(s, lLastPos, lCurPos - lLastPos)
v(o.order + 1) = Mid(s, lCurPos + 1)
End If
ExtractCoef = v
End Function

mada...@gmail.com

unread,
Feb 23, 2018, 2:03:20 AM2/23/18
to
Is it work? Can somebody provide xls example file with such a thing? Thx
Reply all
Reply to author
Forward
0 new messages