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.
Related
I've looked through multiple questions/posts and can't find exactly what I'm looking for.
I have a worksheet that people enter sample names and DNA quant values. The worksheet calculates the volumes of reagents that need to be added to the reaction. The analyst indicates if the sample is destructive or was concentrated (microcon). All of this works fine.
I'm trying to add another macro that highlights a cell if another cell has specific text. The specific text is pulled by the VBA code. The analyst uses that info to enter a volume into a message box. I've tried a bunch of different ways and nothing is working. I think the best way is to have a conditional formatting rule, but I'm not sure how to do that in vba. I'm sure there's a better way to do this, but my vba is pretty basic.
Here is an example of the data. Right now I have a conditional formatting rule that highlights the ul DNA cell if the Destructive column is Y. But, what I would like to do is highlight all the ul of DNA cells that have the sample name "021021RWB_". The sample name would change depending on what the analyst fills out.
Worksheet example
This is what I have so far:
Sub DestructiveRBsTest()
Dim filename As String
Dim sheet As Worksheet
Dim row As Long
Dim column As Long
Dim sample As String
Dim tube As Long
Dim strMsg1 As String
Dim strMsg2 As String
Dim strTitle As String
For row = 8 To 25
tube = Cells(row, 1)
sample = Cells(row, 2)
Quant = Cells(row, 3)
Destructive = Cells(row, 8)
Microcon = Cells(row, 9)
SampleDilution = Cells(row, 5)
DNA = Cells(row, 6)
TE = Cells(row, 7)
If Quant = "RB" And Destructive = "Y" Then
SetID = Split(sample, " ")(0)
MsgBox "Destructive SetID is " & SetID
'Need something here that highlights the DNA cell for all sample cells that have the SetID
strMsg1 = "RB volume should match highest volume of undiluted destructive extract in extraction set."
strMsg2 = "How much volume of DNA should be added for " & sample & "?"
strTitle = "RB associated w/ Destructive Extract"
RBvolume = InputBox(strMsg1 & vbCrLf & vbCrLf & strMsg2, strTitle)
Cells(row, 6) = RBvolume
Cells(row, 7) = 15 - Cells(row, 6)
Else
Cells(row, 6) = "15"
Cells(row, 7) = "0"
End If
Next row
End Sub
So I have been stuck on this problem for a few days. I have looked at some others codes but I am still coming up short. I am not the best at VBA either.
I have a list of investors with their attached payments and dates. I am trying to run a command button that will go through each Account, find their related payments and dates, run the XIRR function and then place the XIRR value at the bottom to the right of each account. This is simple enough to do by hand but when you have a spreadsheet of 15000 cells+ it becomes tedious and I am trying to automate this process. It becomes difficult because each investor has different payment amounts so to find the correct location to place the XIRR value has also stumped me.
Here is an example of my spreadsheet
Dim i As Integer
Dim x As Double
Dim dateArray() As Date
Dim dateStrings() As String
Dim valArray() As Double
ReDim dateArray(Dates.Count)
ReDim valArray(Trans.Count)
ReDim dateStrings(Dates.Count)
'Sheets("InvestorList").PivotTables.GetPivotData("Account", "x") = i
'Sheets("AccountPayments").Find ("i")
End Sub
Public Function MyXIRR(Dates As Range, Trans As Range, Balance As Double)
For i = 1 To Dates.Count
dateArray(i - 1) = Dates.Item(i).Value
Next i
For i = 1 To Trans.Count
valArray(i - 1) = Trans.Item(i).Value
Next i
'Set the date on the "Balance" line to one day after the last transaction date
dateArray(Dates.Count) = DateAdd("d", 1, Dates.Item(Dates.Count))
valArray(Trans.Count) = -1 * Balance
For i = 0 To Dates.Count
dateStrings(i) = Format(dateArray(i), "mm/dd/yyyy")
Next i
MyXIRR = Application.WorksheetFunction.Xirr(valArray, dateStrings)
End Function
So I counseled with a college and he helped reduce my code to something much simpler and cleaner. I ran this code with data and it worked great. Some spot checking may be needed if an XIRR value doesn't appear right but this helps automate the process.
Private Sub CommandButton1_Click()
Dim myrow As Integer
Dim startrow As Integer
Dim valuerange As String
Dim daterange As String
Dim investor As String
myrow = 2
startrow = 2
investor = Cells(myrow, 1)
Do Until Cells(myrow, 1) = ""
If Cells(myrow + 1, 1) <> investor Then
'We are at the end of the list for the current investor.
daterange = "R" & startrow & "C2:R" & myrow & "C2"
valuerange = "R" & startrow & "C3:R" & myrow & "C3"
Cells(myrow, 4) = "=XIRR(" & valuerange & ", " & daterange & ")"
startrow = myrow + 1
investor = Cells(myrow + 1, 1)
End If
myrow = myrow + 1
Loop
End Sub
I would recommend trying the macro recorder to just record your steps... If you are unsure how to do so, here are the steps!
In Excel:
File
Options
Customize ribbon (left panel)
Choose commands from: (dropbox) select "Main Tabs"
Select developer
Click add>>
Click ok
Click developer tab now on top ribbon
Click record macro (top left corner)
Name macro, set shortcut and description if desired
Do what you want the macro to do.
When you completed it for one investor click stop recording
Click Macros in top left
Select the macro you just made and click edit
Should have a skeleton routine to work into your loop
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)"
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
Can anyone explain what's wrong with the syntax on the line that starts If DBSheet.Range?
Also, I know there is a way to do the calculations "off the sheet" and then spit them back into the sheet? I have an idea on how to do this using .formula and .value, but i am not quite sure how. Can someone explain how i can do this so my calculation is efficient. Thanks!
Dim DBSheet As Worksheet, InSheet As Worksheet, ExSheet As Worksheet, i As Long
Set DBSheet = ThisWorkbook.Sheets("db_main")
Set InSheet = ThisWorkbook.Sheets("interface")
Set ExSheet = ThisWorkbook.Sheets("export")
For i = 2 To 40000
If DBSheet.Range("S" & i) <= InSheet.Range("C20") And DBSheet.Range("S" & i) = InSheet.Range("O15") Then
ExSheet.Range("A" & i) = DBSheet.Range("N" & i)
End If
Next i
Your problem appears to be a type error on your comparison line which also is the first time you reference a Range.
First, verify that the data in those cells is of the datatypes you want (numbers I assume). Second, in my experience Excel will almost always treat ws.Range(...) as a range object which would throw an error in your inequality because it is not just the value you are looking for. You should change that to ws.Range("S" & i).Value or ws.Cells(i, 19).Value. Additionally you probably need to convert that to a number from a string for your comparison using Val() or CDbl() or CInt(). So we have options like:
Val(ws.Range("S" & i).Value)
CDbl(ws.Cells(i, 19).Value)
As far as off sheet calculations, if you are referring to using another worksheet for calculations, you would do basically what you are doing right now just with a 4th worksheet object. If you are referring to calculations in memory, it would be something like...
Dim areaCircle As Double
Dim radius As Double, circumference As Double
Dim ratioOfCircumferenceToArea As Double
radius = CDbl(ws.Cells(i, 19).Value)
areaCircle = radius^2 * 3.14159
circumference = 2 * 3.14159 * radius
ratioOfCircumferenceToArea = circumference / area
Without more information about what you are trying to calculate "off sheet," I can just give you these general cases.