Copy ActiveChart properties to cell (from graphics) [Solved/Closed]

Report
-
 mendokzeni -
Hello,

I hope someone could help me. Working with graphics in excel, I generate dispersion plots from some datas, later I add the trendline, display the equation and Rsquared; what I want is copy the equation and the Rsquared and paste it in some cell. I hope someone would help me.

I put the code I use:

Dim lastRow1 As Long
Dim lastRow2 As Long
'COPY DATA

lastRow1 = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
lastRow2 = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
Range("D11:D" & lastRow1 & ",E11:E" & lastRow2).Select

'Range(Range(Range("D11"), Range("D11").End(xlDown)), Range(Range("E11"), Range("E11").End(xlDown))).Select
'ADD PLOT

ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
ActiveChart.SetSourceData Source:=Range("D11:D" & lastRow1 & ",E11:E" & lastRow2)
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).Trendlines.Add
ActiveChart.FullSeriesCollection(1).Trendlines(1).Select
'MOVE THE CHART
With ActiveChart.Parent
.Top = Range("N7").Top
.Left = Range("N7").Left
End With
'ADD TRENDLINE, EQUATION AND RSQUARED
Selection.Type = xlPower
Selection.DisplayEquation = True
Selection.DisplayRSquared = True

Thanks

2 replies

Posts
2676
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 3, 2020
448
Hi Mendokzeni,

When you put the below piece of code at the end of your code, then the Equation value will be put in H1 and the RSquared will be put in H2. Change those cell references to put the values in a place to your liking.

Here is the piece of code:
Dim myER As String
Dim sNumb As Integer
ActiveChart.FullSeriesCollection(1).Trendlines(1).Select
myER = Selection.DataLabel.Text
sNumb = InStr(myER, "")

Range("H1").Value = Left(myER, sNumb - 1)
Range("H2").Value = Right(myER, Len(myER) - sNumb)


Best regards,
Trowa
Thank you very much TrowaD. With a few modifications it works perfectly.

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!