W
willinusf
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
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