vba use linest to calculate polynomial coefficients and index to output - vba

I have two rows of data, fracture pressure and depth. I have to code in vba to generate the polynomial (quadratic for this case) equation and then output the coefficients to the worksheet. I am using Linest and Index. For this two rows of data, I don't know how many datasets I have because I need to delete some noisy data first (the definition of noisy data is randomly so the number of datasets vary each time), so I can't use something like "A17:A80" in the linest function. However, it looks like the worksheet function in vba can't work for arrays.
Dim Frac_x, Frac_y As Range
Dim X
Set Frac_x = Range(Cells(17, 1), Cells(e - 1, 1))
Set Frac_y = Range(Cells(17, 7), Cells(e - 1, 7))
X= Application.WorksheetFunction.LinEst(Frac_y,Frac_x,{1,2})
Cells(3, 8).Value = Application.WorksheetFunction.Index(X, 1, 1)
Cells(4, 8).Value = Application.WorksheetFunction.Index(X, 1, 2)
Cells(5, 8).Value = Application.WorksheetFunction.Index(X, 1, 3)
In this code, e is defined in the previous code, (e-1) represents the total number of datasets. However, I keep getting { is a invalid character for the line: X= Application.WorksheetFunction.LinEst(Frac_y,Frac_x,{1,2})
Then I did some researches and modified the code to:
Dim Frac_x, Frac_y As Range
Dim X
Set Frac_x = Range(Cells(17, 1), Cells(e - 1, 1))
Set Frac_y = Range(Cells(17, 7), Cells(e - 1, 7))
X = Application.Evaluate("=linest(" & Frac_y & "," & Frac_x & "^ {1,2}))")
Cells(3, 8).Value = Application.WorksheetFunction.Index(X, 1, 1)
Cells(4, 8).Value = Application.WorksheetFunction.Index(X, 1, 2)
Cells(5, 8).Value = Application.WorksheetFunction.Index(X, 1, 3)
Then I keep getting Type Dismatch error for the line:
X = Application.Evaluate("=linest(" & Frac_y & "," & Frac_x & "^ {1,2}))")
I am sure the two ranges frac_y and frac_x their type matches. Anyone could help?

You are right, that Excel VBA can't do things like arrVariable^{1,2}. That must be done with loops over the array items.
But the Evaluate approach should work. But your formula string is not correct. To detect and avoid such incorrectness, I will ever concatenate such formula strings within a String variable first. Then I can simply check the variable's value.
Example, Values are in A17:A26 and G17:G26:
Sub test()
Dim Frac_x As Range, Frac_y As Range
Dim X
e = 27
With ActiveSheet
Set Frac_x = .Range(.Cells(17, 1), .Cells(e - 1, 1))
Set Frac_y = .Range(.Cells(17, 7), .Cells(e - 1, 7))
arrX = Frac_x
ReDim arrX2(1 To UBound(arrX), 1 To 2) As Double
For i = LBound(arrX) To UBound(arrX)
arrX2(i, 1) = arrX(i, 1)
arrX2(i, 2) = arrX(i, 1) * arrX(i, 1)
Next
X = Application.LinEst(Frac_y, arrX2)
'sFormula = "=LINEST(" & Frac_y.Address & "," & Frac_x.Address & "^{1,2})"
'X = Application.Evaluate(sFormula)
.Range(.Cells(3, 8), .Cells(5, 8)).Value = Application.Transpose(X)
End With
End Sub
Hints: Use Application.LinEst instead of Application.WorksheetFunction.LinEst. The latter will throw an error if the function cannot work while the first will return an error value instead. So the first will not interrupt the program as the latter will do.

Related

VBA Matrix search

Im having issues with adding values to a Matrix. The first part is working fine, where i am adding values to columns 1-7 from "Example".
However, i have another sheet from which i want to lookup values for Matrix's column 8. The value I want can be found if i can lookup the Example(i,3), which is stored in the Matrix. How do I search a another range for the value that is stored in the Matrix?
Currently im getting the object not defined error on row: "Set cl = ExampleSet2(i, 10).Find(Example(i, 3), LookIn:=xlValues)"
ReDim Matrix(1 To x, 1 To 8)
x = 0
For i = LBound(Example) To UBound(Example)
If CStr(Example(i, DDKolumn)) = DDKey Then
x = x + 1
Matrix(x, 1) = Example(i, 8) & " | " & Example(i, 2)
Matrix(x, 2) = Example(i, 1)
Matrix(x, 3) = Example(i, 3)
Matrix(x, 4) = Example(i, 4)
Matrix(x, 5) = Example(i, 5)
Matrix(x, 6) = Example(i, 6)
Matrix(x, 7) = Example(i, 7)
For y = LBound(ExampleSet2) To UBound(ExampleSet2)
With Sheet14
Set cl = ExampleSet2(i, 10).Find(Example(i, 3), LookIn:=xlValues)
If Not cl Is Nothing Then
Matrix(x, 8) = ExampleSet2(y, 11)
End If
End With
Next y
End If
Next i
.Find is a method of a Range object. ExampleSet is a Variant array, not a Range.
ExampleSet2 = Sheets("Example").Range("A20:I" & Variable) '<~ this is not a Range object
I honestly don't see why you need an array, or even a loop. Just use a Range, and make sure to Set.
Dim ExampleSet2 as Range
Set ExampleSet2 = Sheets("Example").Range("A20:I" & Variable)
Now you can .Find on ExampleSet2 or on a subset of it.

Code checking/helping

can someone please look into my code and say me where is the mistake cause I got a type mismatch error message ? With this code I would like to delete all rows who which contain "0" in the respective cells.
I got the error message for the line where is standing: sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
Also I had to declare the variable "c00" and I choosed "c00 As Variant". I don't know if it its correct. I would appreciate someone helping me to solve the problem.
Dim sn As Variant, c00 As Variant
sn = Sheets(1).UsedRange
For j = 1 To UBound(sn)
If sn(j, 4) & sn(j, 5) & sn(j, 6) & sn(j, 7) & sn(j, 8) & sn(j, 9) = "000000" Then c00 = c00 & "|" & j
Next
If c00 <> "" Then
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
Sheets(1).UsedRange.ClearContents
Sheets(1).Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End If
Original Code
Dim LR%
LR = Cells(Rows.Count, 3).End(xlUp).Row
Set Myrange = Range("D2:AO" & LR).SpecialCells(xlCellTypeBlanks) 'nur Leerzellen
Myrange.Formula = "0"
ActiveSheet.UsedRange
Set r = ActiveSheet.UsedRange
lastrow3 = r.Rows.Count + r.Row - 1
For j = lastrow3 To 1 Step -1
If (Cells(j, 4) = 0 And Cells(j, 5) = 0 And Cells(j, 6) = 0 And Cells(j, 7) = 0 And Cells(j, 8) = 0 And Cells(j, 9) = 0) Then
Rows(j).Delete
End If
Next j
Image w/ Error
Edit: the error was from attempting to use Application.Index on an array larger than the function size limit. Redirect to here for Q&A an on alternative option to Application.Index.
I'll break down my analysis of your code:
Application.Index(Array, Row_Number, Column_Number)
The code you currently have:
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
is saying that the parameters are:
Array: sn
Row_Number: Application.Transpose(Split(Mid(c00, 2), "|"))
Column_Number: [transpose(row(1:8))]
The Array section looks fine to me. The Row numbers will, I think(?), be the values for j which you collected in c00 (although the Application.Transpose may not be necessary Correction: it is in this scenario.). I have no idea what is going on with your Column_Number parameter....
Issues:
Application.Index keeps the selected columns/rows. However, your if statement selects the values of j where the rows are entirely 0, so instead of losing them, you would be keeping only those rows.
If your intention is to keep all the columns, you can just input 0 into the Column_Number parameter. Correction: this works when only selecting a single row to keep. If selecting multiple rows, all columns must be listed as well.
Corrected code:
Since this code does delete data, you should save a copy of the data before running this code on it.
Note: c00 can be a Variant; String also works. You will need to also copy over the fillA function, as well.
Dim sn As Variant, c00 As String
sn = Sheets(1).UsedRange
' Changed condition based on your post with previous code. (And negated)
For j = 1 To UBound(sn)
If Not ((Cells(j, 4) = 0 And Cells(j, 5) = 0 And Cells(j, 6) = 0 And Cells(j, 7) = 0 And Cells(j, 8) = 0 And Cells(j, 9) = 0)) Then c00 = c00 & "|" & j
Next
If c00 <> "" Then
' Corrected inputs for Application.Index, Added helper function "fillA".
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), fillA(1, UBound(sn, 2) - LBound(sn, 2) + 1))
Sheets(1).UsedRange.ClearContents
Sheets(1).Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End If
Function fillA(min As Long, max As Long) As Variant
Dim var() As Variant, i As Long
ReDim var(1 To max - min + 1)
For i = min To max
var(i) = i + min - 1
Next i
fillA = var
End Function
Edit:
Realized this did not address your issue. I suspect that the error was from the [transpose(row(1:8))] you were inserting for the Column_Number parameter.
Maybe someone else has a simpler way of doing what I did with the fillA function (what I believe you were attempting).

(Excel VBA) write formula for the whole column

I have 30 excel files need to be done with the same operation. I have non-fixed number of rows in my excel files. For all excel files, I want to apply VBA to write IF function into the column"H" from the second row to the last row.
Here is the formula I need to write (for the second row): =IF(AND(C2=C3,C2=C1,G2=TRUE,G1=FALSE,G3=TRUE),"O",IF(AND(C2=C3,C2<>C1,G2=TRUE),"FromYes",IF(AND(C2=C1,C2=C3,G2=TRUE,G1=TRUE,G3=FALSE),"D",IF(AND(C2=C1,C2<>C3,G2=TRUE),"ToTmr",""))))
Other rows shall have similar formula.
Is there any way for me to write a formula directly in vba for the whole column "H"?
I have tried some code like this, but it run extremely slow
For x = 2 To lastRow
If ws.Cells(x, 3) = ws.Cells(x + 1, 3) And ws.Cells(x, 3) = ws.Cells(x - 1, 3) And ws.Cells(x, 7) = True And ws.Cells(x - 1, 7) And ws.Cells(x + 1, 7) = True Then
ws.Cells(x, 8) = "O"
Else
If Cells(x, 3) = Cells(x + 1, 3) And (Cells(x, 3) <> Cells(x - 1, 3)) And Cells(x, 7) = True Then
Cells(x, 8) = "FromYes"
Else
If Cells(x, 3) = Cells(x - 1, 3) And Cells(x, 3) = Cells(x + 1, 3) And Cells(x, 7) = True And Cells(x - 1, 7) = True And Cells(x + 1, 7) = False Then
Cells(x, 8) = "D"
Else
If Cells(x, 3) = Cells(x - 1, 3) And Cells(x, 3) <> Cells(x + 1, 3) And Cells(x, 7) = True Then
Cells(x, 8) = "ToTmr"
End If
End If
End If
End If
Next x
Next d
There are a few things to change in your approach. Firstly, use the fact that you can set cell formulas with VBA. Secondly, use the fact that you can set cell formulas for an entire range in VBA. Thirdly, if your formula is fast, use it instead of code (this is not a hard and fast rule, but if you're new to VBA or not using it often, it's simpler to use formulas).
Using those ideas, I came up with this:
With Sheet1
.Range(.Cells(2, 8), .Cells(lastRow, 8)).FormulaR1C1 = _
"=IF(AND(RC[-5]=R[1]C[-5],RC[-5]=R[-1]C[-5],RC[-1],NOT(R[-1]C[-1]),R[1]C[-1]),""O""," & _
"IF(AND(RC[-5]=R[1]C[-5],RC[-5]<>R[-1]C[-5],RC[-1]),""FromYes""," & _
"IF(AND(RC[-5]=R[1]C[-5],RC[-5]=R[-1]C[-5],RC[-1],R[-1]C[-1],NOT(R[1]C[-1])),""D""," & _
"IF(AND(RC[-5]<>R[1]C[-5],RC[-5]=R[-1]C[-5],RC[-1]),""ToTmr"",""""))))"
End With
This is setting the formula for the range of column H, rows 2 through the lastRow, for Sheet1 equal to your formula. The removes the need to loop rows, making it much quicker.
I always find it is easier to work with R1C1 format when entering formulas through VBA. It's easy enough to get that format; you just need to go the formula options in Excel and select R1C1 Reference Style. Then you can copy it into the VBA and escape quotation marks with another quotation mark.
Using this, you can easily write a tool that loops through the files, finds the last row on the appropriate sheet, and sets the formula.

Excel VBA: Programmatically setting X,Y,Z values for chart generation

The following code succesfully generates an XY scatter plot with dynamically changing ranges. However, the hurdle I can't get over is how to programmatically set the x,y,z values for the scatterplot to generate a bubble chart. I've made attempt at doing so(as you can see in the code) but it doesn't work.
Any helps is appreciated
dim a as long
dim b as long
dim i as long
dim m as long
dim j as long
For i = 2 To lastrow
If Cells(i, "A") = "Regression #" & m & " Output" Then
a = i 'save regression #1 row number, where it begins
For j = 2 To a
If Cells(j, "A") = "Regression #" & m + 1 & " Output" Then
b = j
End If
Next j
Set rngx = Range(Cells(b + 1, 2), Cells(a - 1, 2))
Set rngy = Range(Cells(b + 1, 7), Cells(a - 1, 7))
Set rngz = Range(Cells(b + 1, 8), Cells(a - 1, 8))
Sheets("Chart Table").Shapes.AddChart.Select
ActiveChart.ChartType = xlBubble
ActiveChart.SetSourceData Source:=Union(rngx, rngy, rngz)
With ActiveChart.SeriesCollection.NewSeries
'.Name = ActiveSheet.Range("B2:B13")
.value = rngy
.xvalues = rngx
.BubbleSizes = rngz
End With
With ActiveChart
.SetElement (msoElementChartTitleAboveChart)
.Legend.Delete
.ChartTitle.Select
.ChartTitle.Text = Cells(a, 1).Value
End With
Else
End If
Next i
For example, if I have just one row of data(one x, one y, one z) - then I want Excel to know that it means there's only one bubble. Right now it reads it as 3 separate bubbles, disregarding the fact there's a bubble sizing element
If the union of rngx, rngy, and rngz is a contiguous range, it works fine. Since these ranges are separated by several columns, your SetSourceData command is incomplete, and treats their union as a set of Y values, and uses the default (1, 2, 3) as X values and (1, 1, 1) as bubble sizes.
However, this small change fixes your code:
ActiveChart.SetSourceData Source:=Union(rngx, rngy, rngz), PlotBy:=xlColumns

Transform Excel data into custom format

I'm attempting to transform a large Excel input table into a custom format, also as an Excel table. Visually this is what I need to accomplish:
The psuedo-code I've come up with to solve the problem goes as follows:
Pseudo code:
// Column A is of higher level than column B
Initialize dictionary
Read the entire spreadsheet into system memory
While(sheet has records) {
Loop through spreadsheet records top-down
Start at cell A1
Look to the immediate right of column A
if(A:B not already in dictionary){
Dictionary>> Append B as child of A in dictionary // Must find correct entry and append value
}
Move to cell A+1
}
Once sheet is out of records {
Move one column to the right
Repeat while method
Do this until entire column is null
}
while (dictionary has records) {
Key = Column A value
List of values = Column B value
Save values as new Excel sheet
}
end
I'm not sure if there are libraries that exist that would accomplish what I need here, I can use whatever language offers a solution.
Appreciate any input from you all.
Stuff the 'Raw Data' into a two dimensional variant array and cycle through each rank, building the children of the parent or sub-parent as the case may be.
Sub collate_family_values()
Dim v As Long, w As Long, vVALs As Variant
Dim sPAR As String, sTMP As String
With ActiveSheet '<-set this worksheet reference properly!
.Columns("f:g").EntireColumn.Delete
.Cells(1, 6) = "Output Data"
.Cells(2, 6).Resize(1, 2) = .Cells(2, 1).Resize(1, 2).Value
vVALs = Application.Transpose(.Range(.Cells(3, 1), .Cells(Rows.Count, 4).End(xlUp)).Value)
For w = LBound(vVALs, 1) To UBound(vVALs, 1) - 1
sTMP = ChrW(8203)
sPAR = vVALs(w, LBound(vVALs, 2))
For v = LBound(vVALs, 2) To UBound(vVALs, 2)
If Not CBool(InStr(1, sTMP, ChrW(8203) & vVALs(w + 1, v) & ChrW(8203), vbTextCompare)) Then
sTMP = sTMP & vVALs(w + 1, v) & ChrW(8203)
End If
If sPAR <> vVALs(w, Application.Min(v + 1, UBound(vVALs, 2))) Or v = UBound(vVALs, 2) Then
.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Resize(1, 2) = _
Array(sPAR, Replace(Mid(sTMP, 2, Len(sTMP) - 2), ChrW(8203), ", "))
sTMP = ChrW(8203)
If v < UBound(vVALs, 2) Then sPAR = vVALs(w, v + 1)
End If
Next v
Next w
End With
End Sub
I moved the 'Output Dat' results to the right of the 'Raw Data' due to an unknown number of rows to adjust for.