Code Post: Extract Trendline coefficients
David J. Braden
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
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
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
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
Const cMaxFormat = "0.00000000000000E+00"
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
Application.Volatile
On Error GoTo HanErr
Set o = Sheets(vSheet).ChartObjects(vCht).Chart. _
SeriesCollection(vSeries).Trendlines(vTL)
TLcoef = ExtractCoef(o, cFirstNumPos)
TLcoef = CVErr(xlErrValue)
MsgBox TLcoef
Function TLeval(vX, vSheet, vCht, vSeries, vTL)
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
lCurPos = InStr(s, "x")
If lCurPos = 0 Then
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 + 1) = Mid(s, lCurPos + 1)
ExtractCoef = v
End Function
