I made this code a year or so ago and it's been working fine. Recently, however, it broke. I am assuming there was a Windows update that changed the way Excel's macros worked with charts. The pertinent sections of my code perform the following:
Create an XY Scatter chart on a "prep" worksheet
Create a trendline for each data series on the XY Scatter
Parse each trendline text for slope and R^2, coping them as text onto another "summary" worksheet
What I've found is that Step 1 and 2 work fine, but when I try to parse the trendline text (expecting something like y = 0.0289x + 143), I get an empty string (see the commented out MsgBox, below). What's weirder is that when the Macro finishes (or fails) the chart updates and the text shows normally.
' Create the graph for the linear part of the data set
Worksheets(PrepSheetName).Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmooth
ActiveChart.SetSourceData Source:=Range("$B$19:$G$38")
' ActiveChart.Name = "Linear"
'MsgBox "Past linear creation"
' Add each data set to the chart individually
ActiveChart.PlotArea.Select
For i = 1 To 5
' Construct a string like ='Data'!$C$19:$C$38
YValues = "='" & PrepSheetName & "'!$" & DSMeasCol(i) & "$"
YValues = YValues & CStr(PrepDataStart) & ":$" & DSMeasCol(i) & "$"
YValues = YValues & CStr(PrepDataEnd(i))
' Construct a string like ='Data'!$C$19:$C$38
XValues = "='" & PrepSheetName & "'!$" & DSCmdCol(i) & "$"
XValues = XValues & CStr(PrepDataStart) & ":$" & DSCmdCol(i) & "$"
XValues = XValues & CStr(PrepDataEnd(i))
' Give the chart values
ActiveChart.SeriesCollection(i).Values = YValues
ActiveChart.SeriesCollection(i).XValues = XValues
' Create a trendline for the chart
Dim TL As Trendline
Set TL = ActiveChart.SeriesCollection(i).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=1, DisplayRSquared:=0, _
Name:="LC" & CStr(i) & " Trend")
TL.DisplayEquation = True
TL.DisplayRSquared = False
' Exract the trendline formula
Dim Eqn As String
TL.Select
'MsgBox "Trendline Text: " + TL.DataLabel.Text
Eqn = Split(TL.DataLabel.Text, "=")(1)
' ... and place it on the coversheet ...
CoverSheet.Cells(CSResults(i), CSFitSlope).Value = Split(Eqn, "x")(0)
CoverSheet.Cells(CSResults(i), CSFitOffset).Value = Split(Eqn, "x")(1)
'Find the RSquared of the Trendline
TL.DisplayEquation = False
TL.DisplayRSquared = True
TL.Select
Eqn = TL.DataLabel.Text
Eqn = Split(TL.DataLabel.Text, "=")(1)
' ... and place it on the coversheet ...
'CoverSheet.Cells(CSResults(i), CSFitCorr).Value = Eqn
Next i
If I try to run diagnostic code to parse the tredline datalabel text after running the macro the first time, it sees the text. When running the diagnostic code, though, I can't change the type of trendline data that is shown. I would expect, for example, that if I run:
TL.DisplayEquation = True
TL.DisplayRSquared = False
MsgBox "Should show Equation."
TL.DisplayEquation = False
TL.DisplayRSquared = True
MsgBox "Should show R^2."
... that I should see the trendline data label only show the equation when the first message box appears and the second message box should freeze the screen such that only the the R^2 is showing. When I run code like this, though, I find that my assumption is not true: The datalabel stays frozen until the macro completes, even with ScreenUpdating = True It seems like my charts aren't updating when the macro runs, but only updates at the end.
I've tried putting DoEvents and Application.Recalculate after creating the trendline, but it just causes my Excel to crash. Adding Application.ScreenUpdating = True or False doesn't seem to help, either...
Any ideas? I'm at a total loss...
Please let me know if I haven't provided enough information or anything is unclear.
Thanks!
I ended up using chillin's suggestion and used LinEst. It seems this is a bug in how Excel handles Chart DataLabels during Macro execution, as per this thread. To summarize, my code is almost the same as above, but with the following change using LinEst instead of parsing the Trenline's DataLabel:
' Create a trendline for the chart
Dim TL As Trendline
Set TL = ActiveChart.SeriesCollection(i).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=1, DisplayRSquared:=0, _
Name:="LC" & CStr(i) & " Trend")
' Generate the trendline constants and place them on the summary sheet
CoverSheet.Cells(CSResults(i), CSFitSlope).Value = "=INDEX(LINEST(" & YValues & "," & XValues & ",TRUE, TRUE), 1)"
CoverSheet.Cells(CSResults(i), CSFitOffset).Value = "=INDEX(LINEST(" & YValues & "," & XValues & ",TRUE, TRUE), 1,2)"
CoverSheet.Cells(CSResults(i), CSFitCorr).Value = "=INDEX(LINEST(" & YValues & "," & XValues & ",TRUE, TRUE), 3)"
Related
I am trying to program a vba code to draw a smooth curve among control points as showing in the figure below:
This is part of the code, is there any suggest how to curve fitting among control points (polynomial regression). I just want guide or advice how to make this code to work.
Public Sub TestLinest()
Dim x
Dim i As Long
Dim evalString As String
Dim sheetDisplayName As String
Dim polyOrder As String
' this is whatever the name of your sheet containing data:
sheetDisplayName = "Sheet1"
' this gets the index of the last cell in the data range
i = Range(sheetDisplayName & "!A17").End(xlDown).Row
' Obviously change this depending on how many polynomial terms you need
polyOrder = "{1,2,3}"
evalString = "=linest(" & sheetDisplayName & "!E6:E" & i & ", " & sheetDisplayName & "!D6:D" & i & "^" & polyOrder & ")"
x = Application.Evaluate(evalString)
Cells(3, 8) = x(1)
Cells(4, 8) = x(2)
Cells(5, 8) = x(3)
Cells(6, 8) = x(4)
End Sub
Just a suggestion; Not sure about VBA code (need to explore).
To get a polynomial curve in your chart, you can simply follow these steps;
Right click on data points on scatterplot
Click on "Format Trendline"
Under Trendline options, you will see "Polynomial" with order range
of 2 to 6.
After setting the name of a series in an Excel chart sheet with
ActiveChart.SeriesCollection(1).Name = dat.Cells(1, 2)
the chart legend shows the current value of the referenced cell but the 'series name' field in the 'Edit series' dialog is empty. Changes to the cells value don't show up in the chart legend.
Any advice on how to set the series name properly?
Assuming that dat is a Worksheet-Variable pointing to your data sheet:
Dim nameFormula As String
nameFormula = = "=" & "'" & dat.Name & "'" & "!" & "$B$1"
ActiveChart.SeriesCollection(1).Name = nameFormula
nameFormula will now contain "='Daten UVNIR'!$B$1". With that, the name of the series is set to the cell B1 and not a fixed string (I always recommend to use intermediate variables, it helps debugging).
I would strongly recommend not to use ActiveChart. Instead, use something like
Dim co As ChartObject, ch As Chart, ser As Series
Set co = dat.ChartObjects(1)
Set ch = co.Chart
Set ser = ch.SeriesCollection(1)
(...)
ser.Name = nameFormula
(you can use the name of the ChartObject instead of 1 as index)
Update: Haven't noticed that you are working with a Chart Sheet. In that case, use
Dim ser As Series
set ser = Sheets("Chart1").SeriesCollection(1)
Try this code:
ThisWorkbook.Sheets("Chart1").SeriesCollection(1).Name = "=" & dat.Cells(1, 2).Address(External:=True)
I am trying to automate a process to generate 2 XYScatter graphs from 1 table and seem to be making a mess of it. There are multiple issues I'm hitting so I will try to describe 1 at a time.
The first issue is setting the X & Y ranges. The table could contain anywhere from 4 to a few hundred rows. Column A = X values, column F says if it is level 1/graph 1 or level 2/graph 2, & column J = Y value. I created 4 Range variables, RngL1X, RngL1Y, RngL2X & RngL2Y. Then I wrote some code to loop through column F and fill the data ranges (see below).
What is the correct syntax to make an empty range? Before I can use them, the ranges need to have initial values. I would like to set them to "Empty" but VBA doesn't like any of the syntax I have tried: Set RngL1X = " ", RngL1X = IsNull, RngL1X = IsEmpty, etc.
Here's the loop code for filling the variables. I can't tell how well it will work until I solve the problem of the initial values.
Range("F2").Select
Do While IsEmpty(ActiveCell) = False
If ActiveCell Like "*Level 1*" Then
RngL1X = RngL1X & ", " & ActiveCell.Offset(0, -5)
RngL1Y = RngL1Y & ", " & ActiveCell.Offset(0, 4)
Else
RngL2X = RngL2X & ", " & ActiveCell.Offset(0, -5)
RngL2Y = RngL2Y & ", " & ActiveCell.Offset(0, 4)
End If
Debug.Print RngL2Y
ActiveCell.Offset(1, 0).Select
Loop
When I tested the loop with the variables as a string (not a range) it worked well.
I want to use a for loop to switch between X and Y ranges for all Series in an active Scatter chart.
The exiting Series have value like this:
=SERIES("Name",Sheet1!$B$3:$B$23,Sheet1!$A$3:$A$23)
I want to change to:
=SERIES("Name",Sheet1!$A$3:$A$23,Sheet1!$B$3:$B$23)
switching between X and Y ranges.
Please help to complete the function:
Sub SwitchXY()
For i = 1 To ActiveChart.SeriesCollection.Count
'Please help here!
Next
End Sub
I am not sure why do you use a for next in this case, but if you simply want to change the formula of the chart. I believe you can work by this way:
Sub SwitchXY()
Dim formulaArray() As String
formulaArray = Split(ActiveChart.FullSeriesCollection(1).Formula, ",")
ActiveChart.FullSeriesCollection(1).Formula = formulaArray(0) & "," & _
formulaArray(2) & "," & _
formulaArray(1) & "," & _
formulaArray(3)
End Sub
I have an Excel bar chart, with horizontal axis labels. Some of the title labels are blank as shown in the graph. How I can I deselect these labels form the the axis labels so they are not shown in the graph through vba code.
Thank you and your help is much appreciated...
I just avoided the whole deselecting thing by building the Chart CollectionSeries XValues and Values string based on the required specific cells. Avoiding the blank empty cell.
Dim chartPhaseXValues As String
Dim chartDurationValues As String
'For Loop Here
chartPhaseXValues = chartPhaseXValues & oExcel.ActiveSheet.Name & "!" & _
oExcel.Range("A1").Offset(rowCount, 1).Address & ","
hartDurationValues = chartDurationValues & oExcel.ActiveSheet.Name & "!" & _
oExcel.Range("A1").Offset(rowCount, 4).Address & ","
'End For Loop
' Remove the trailing , at the end of each string
chartPhaseXValues = Left(chartPhaseXValues, Len(chartPhaseXValues) - 1)
chartDurationValues = Left(chartDurationValues, Len(chartDurationValues) - 1)
' Add the Series to the graph
oExcel.ActiveChart.SeriesCollection.NewSeries
oExcel.ActiveChart.FullSeriesCollection(1).Name = "=""StartDate"""
oExcel.ActiveChart.FullSeriesCollection(1).Values = "=" & chartDurationValues
oExcel.ActiveChart.FullSeriesCollection(1).XValues = "=" & chartPhaseXValues