Home |
Search |
Today's Posts |
#1
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
thanks for the link. Oddly enough, my colleague took your class at St.
FX back in 2001. |
#4
|
|||
|
|||
Anyone else?
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Using other workbooks.. | Excel Worksheet Functions | |||
Make Change Case in Excel a format rather than formula | Excel Worksheet Functions | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
Code Post: Extract Trendline coefficients | Excel Discussion (Misc queries) |