Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
willinusf
 
Posts: n/a
Default 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

  #2   Report Post  
Bernard Liengme
 
Posts: n/a
Default

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



  #3   Report Post  
willinusf
 
Posts: n/a
Default

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

  #4   Report Post  
willinusf
 
Posts: n/a
Default

Anyone else?

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Using other workbooks.. DavidMunday Excel Worksheet Functions 2 July 1st 05 07:35 AM
Make Change Case in Excel a format rather than formula Kevin Excel Worksheet Functions 1 March 18th 05 08:53 PM
Opening a file with code without a set file name jenkinspat Excel Discussion (Misc queries) 1 March 4th 05 10:50 AM
Opening a file with code without a set file name jenkinspat Excel Discussion (Misc queries) 1 March 3rd 05 03:40 PM
Code Post: Extract Trendline coefficients who Excel Discussion (Misc queries) 2 January 10th 05 11:36 PM


All times are GMT +1. The time now is 05:15 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"