VBA code to extract m-coefficient in linear trendlines from ALL charts
 

I have no VBA experience and have been trying to modify a code I found
online used to extract all coefficients from the trendline textbox.
I've pretty much gotten nowhere. The problem is that it's written to
extract only the coefficients of trendline 1 in chart 1. What I would
like is to extract only the m coefficient of mx+b of all of the
trendlines in however many charts I may have in the sheet. The charts
each have 4 trendlines in them. I would like for chart 1 tline 1
extracted to D3 and tline 2 to E3. Then tline 3 to D4 and tline 4 to
E4. Chart 2 would have tline 1 to D5 and tline 2 to E5. See the
pattern? Every successive chart would have tlines 1 and 2 directly
below the previous charts 3 and 4. Also, these must be extracted to
the above cells in sheet 2. I can have as many as 20 charts in a sheet
all of which have 4 trendlines each which need to have the slopes
extracted. copy and paste gets kind of tedious after a while. Any
help would be extremely appreciated. Here's what I tried to work from:

Sub GetFormula()
Dim sStr As String, sStr1 As String
Dim sFormula As String, j As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tLine As trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.trendlines.Count = 1 Then
Set tLine = ser.trendlines(1)
If tLine.DisplayEquation Then
sFormula = tLine.DataLabel.Text '<== this gets the formula
sFormula = Application.Substitute(sFormula, _
"y = ", "")
sFormula = Application.Substitute(sFormula, _
" + ", ",")
'Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula)
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) Then
If i = Len(sFormula) Then
sStr1 = sStr1 & sChar
End If
varr(j) = sStr1
sStr1 = ""
j = j + 1
Else
sStr1 = sStr1 & sChar
End If
Next
ReDim Preserve varr(1 To j - 1)
Set rng = Range("AZ6")
j = 1
For i = LBound(varr) To UBound(varr)
rng(j).Value = Val(varr(i))
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub

If you are happy with the LINEST results see my Tip&Tricks page to use
LINEST for a polynomial fit.
best wishes
--
Bernard V Liengme
www.stfx.ca/people/bliengme
remove caps from email

"willinusf" wrote in message
oups.com...
I have no VBA experience and have been trying to modify a code I found
online used to extract all coefficients from the trendline textbox.
I've pretty much gotten nowhere. The problem is that it's written to
extract only the coefficients of trendline 1 in chart 1. What I would
like is to extract only the m coefficient of mx+b of all of the
trendlines in however many charts I may have in the sheet. The charts
each have 4 trendlines in them. I would like for chart 1 tline 1
extracted to D3 and tline 2 to E3. Then tline 3 to D4 and tline 4 to
E4. Chart 2 would have tline 1 to D5 and tline 2 to E5. See the
pattern? Every successive chart would have tlines 1 and 2 directly
below the previous charts 3 and 4. Also, these must be extracted to
the above cells in sheet 2. I can have as many as 20 charts in a sheet
all of which have 4 trendlines each which need to have the slopes
extracted. copy and paste gets kind of tedious after a while. Any
help would be extremely appreciated. Here's what I tried to work from:

Sub GetFormula()
Dim sStr As String, sStr1 As String
Dim sFormula As String, j As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tLine As trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.trendlines.Count = 1 Then
Set tLine = ser.trendlines(1)
If tLine.DisplayEquation Then
sFormula = tLine.DataLabel.Text '<== this gets the formula
sFormula = Application.Substitute(sFormula, _
"y = ", "")
sFormula = Application.Substitute(sFormula, _
" + ", ",")
'Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula)
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) Then
If i = Len(sFormula) Then
sStr1 = sStr1 & sChar
End If
varr(j) = sStr1
sStr1 = ""
j = j + 1
Else
sStr1 = sStr1 & sChar
End If
Next
ReDim Preserve varr(1 To j - 1)
Set rng = Range("AZ6")
j = 1
For i = LBound(varr) To UBound(varr)
rng(j).Value = Val(varr(i))
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub

thanks for the link. Oddly enough, my colleague took your class at St.
FX back in 2001.

Anyone else?