I am trying in Excel VBA to get some values from a spreadsheet in a square array invert this array. I have the following code:
Private Sub CommandButton1_Click()
Dim A As Variant
Dim i As Integer, j As Integer
ReDim A(1 To 3, 1 To 3) As Double
For i = 1 To 3
For j = 1 To 3
A(i, j) = Cells(i, j).Value
Next j
Next i
A = Application.WorksheetFunction.MInverse(A)
End Sub
In the line:
A = Application.WorksheetFunction.MInverse(A)
I get the error:
run-time error 1004: application defined or object defined error
Can anyone assist me on this?
Try the code below to read a 3×3 array from cell A1 and write the inverse on cell A5.
Private Sub CommandButton1_Click()
Dim A() as Variant, B() as Variant
A = Range("A1").Resize(3,3).Value
B = WorksheetFunctions.MMinverse(A)
Range("A5").Resize(3,3).Value = B
End Sub
There is no need to loop through each cell, which is a slow operation. Read and write whole tables with one command using the Range().Resize().Value syntax.
You may be trying to invert an ill-conditioned matrix. I tried your code on an easy example:
Sub dural()
Dim A As Variant
Dim i As Integer, j As Integer
ReDim A(1 To 3, 1 To 3) As Double
For i = 1 To 3
For j = 1 To 3
A(i, j) = Cells(i, j).Value
Next j
Next i
A = Application.WorksheetFunction.MInverse(A)
For i = 1 To 3
For j = 1 To 3
Cells(i + 5, j + 5).Value = A(i, j)
Next j
Next i
End Sub
and got:
which appears to be correct. (the product of the two matrices is very close to a unit matrix)
Related
New to VBA. I'm trying to create an array of rows.
Basically, I have an entire sheet and want to take all the rows that start with a certain value ("MA") in column 8.
I eventually want to manipulate that array (as if it were a range), and paste it somewhere else in the sheet. Can anyone help? Here's my code so far:
Dim top0M As Variant
ReDim top0M(1 To 1) As Variant
For i = 4 To Rows.Count
If Cells(i, 8).Value Like "MA*" Then
top0M(UBound(top0M)) = Rows(i)
ReDim Preserve top0M(1 To UBound(top0M) + 1) As Variant
End If
Next i
This code runs but I'm not sure how to debug it to know if I even have the right rows inside. Can I paste these rows as if they were a range?
This sets the range and loads the whole into an array then it loads a different array with the lines that you want:
With ActiveSheet 'This should be changed to the name of the worksheet: Worksheets("MySheet")
Dim rng As Range
Set rng = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(4, .Columns.Count).End(xlToLeft).Column))
Dim tot As Variant
tot = rng.Value
Dim top0M As Variant
ReDim top0M(1 To Application.CountIf(.Range("H:H"), "MA*"), 1 To UBound(tot, 2)) As Variant
Dim k As Long
k = 1
Dim i As Long
For i = LBound(tot, 1) To UBound(tot, 1)
If tot(i, 8) Like "MA*" Then
Dim j As Long
For j = LBound(tot, 2) To UBound(tot, 2)
top0M(k, j) = tot(i, j)
Next j
k = k + 1
End If
Next i
End With
'to print to a sheet just assign the values:
Worksheets("sheet1").Range("A1").Resize(UBound(top0M, 1), UBound(top0M, 2)).Value = top0M
Try this code
Sub Test()
Dim x As Variant
x = ActiveSheet.Range("A4").CurrentRegion.Value
x = FilterArray(x, 8, "MA*", True)
ActiveSheet.Range("K14").Resize(UBound(x, 1), UBound(x, 2)).Value = x
End Sub
Function FilterArray(ByVal myRefArr As Variant, ByVal col As Integer, ByVal refValue As String, ByVal equal As Boolean) As Variant
Dim a As Variant
Dim i As Long
Dim j As Long
Dim n As Long
On Error Resume Next
n = 1
If refValue = "" Then
FilterArray = myRefArr
Else
ReDim a(1 To UBound(myRefArr, 1), 1 To UBound(myRefArr, 2))
For i = 1 To UBound(a, 1)
If IIf(equal, UCase(myRefArr(i, col)) Like UCase(refValue), Not (UCase(myRefArr(i, col)) Like UCase(refValue))) Then
For j = 1 To UBound(a, 2)
a(n, j) = myRefArr(i, j)
Next j
n = n + 1
End If
Next i
a = Application.Transpose(a)
ReDim Preserve a(1 To UBound(a, 1), 1 To n - 1)
a = Application.Transpose(a)
FilterArray = a
End If
On Error GoTo 0
End Function
I have an array that I preallocate a bunch of memory before populating, once populate i would like to remove the empty rows at the end, however I get an error. Any suggestions of a good way to do this, without using a second for loop?
Dim myArray() as Variant
ReDim myArray( 1 to 800, 1 to 50)
For i = 1 to 800
' .....fill the array
Next i
Then the next following funcition call fails
ReDim Preserve myArray(1 to 50, 1 to 50)
with the error message:
"Run- time error '9':
Subscript out of range"
You can use Redim Preserve in order to redimension an array. However, this will only work for the last dimension of the array. Here a quick example of doing a redim preserve:
Sub Test()
Dim arrMy()
ReDim arrMy(1 To 10, 1 To 10)
Dim i, j
For i = 1 To 10
For j = 1 To 10
arrMy(i, j) = 1
Next j
Next i
ReDim Preserve arrMy(1 To 10, 1 To 1)
End Sub
In order to sidestep this limitation you can simply create a new array, size it appropriately, and fill it using the data from the first array.
Here is an example of this:
Sub Test2()
Dim arrMy()
ReDim arrMy(1 To 10, 1 To 10)
Dim i, j
For i = 1 To 10
For j = 1 To 10
arrMy(i, j) = 1
Next j
Next i
Dim arrFinal()
ReDim arrFinal(1 To 2, 1 To 10)
For i = 1 To 2
For j = 1 To 10
arrFinal(i, j) = arrMy(i, j)
arrFinal(i, j) = arrMy(i, j)
arrFinal(i, 2) = arrMy(i, j)
Next j
Next i
End Sub
This is not a proper answer to your question, but with regard to avoiding loops, you can experiment with this approach
Sub Test2()
Dim arrMy()
ReDim arrMy(1 To 5, 1 To 5)
Dim i, j
For i = 1 To 5
For j = 1 To 5
arrMy(i, j) = i * j
Next j
Next i
Range("A1").Resize(5, 5) = arrMy
Dim arrFinal()
ReDim arrFinal(1 To 2, 1 To 5)
arrFinal = Application.Index(arrMy, Evaluate("ROW(1:2)"), Array(1, 2, 3, 4, 5))
Range("H1").Resize(2, 5) = arrFinal
End Sub
I need to do the following:
lift the range C2:AU264 into an 2D array
create another 1D array, (1 To 11880)
fill second array with values from the first one ("transpose")
write array 2 back to the sheet
Here is the code I am using:
Private Ws As Worksheet
Private budgets() As Variant
Private arrayToWrite() As Variant
Private lastrow As Long
Private lastcol As Long
Private Sub procedure()
Application.ScreenUpdating = False
Set Ws = Sheet19
Ws.Activate
lastrow = Ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row
lastcol = Ws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
ReDim budgets(1 To lastrow - 1, 1 To lastcol - 2)
budgets= Ws.Range("C2:AU265")
ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1))
k = 0
For j = 1 To UBound(budgets, 2)
For i = 1 To UBound(budgets, 1)
arrayToWrite(i + k) = budgets(i, j)
Next i
k = k + lastrow - 1
Next j
Set Ws = Sheet6
Ws.Activate
Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = arrayToWrite
'For i = 1 To UBound(arrayToWrite)
'Ws.Range(Cells(i + 1, 5).Address).Value = arrayToWrite(i)
'Next i
Application.ScreenUpdating = True
End Sub
This just writes the first value from the range C2:AU264 (the first element of the first array) through the whole range E2:E11881. If however, I un-comment the For loop just before the end of my script and do it that way, it does work, but is slow. How can I write the array correctly using the first statement?
If you want to write an array to a range, the array must have two dimensions. Even if you only wish to write a single column.
Change
ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1))
to
ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1), 1 To 1)
and
arrayToWrite(i + k) = budgets(i, j)
to
arrayToWrite(i + k, 1) = budgets(i, j)
simply use transpose... change
Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = arrayToWrite
to
Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = Application.Transpose(arrayToWrite)
Hint: there is no need for ReDim budgets(1 To lastrow - 1, 1 To lastcol - 2).
If budgets is a variant then budgets = Ws.Range("C2:AU265") will automatically set the ranges (upper left cell (in this case C2) will be (1, 1)).
EDIT
Assuming you only want to write down all columns (one after another) below each other, you can shorten the macro a bit like that:
Private Sub procedure()
Dim inArr As Variant, outArr() As Variant
Dim i As Long, j As Long, k As Long
With Sheet19
.Activate
inArr = .Range(, .Cells(2, 3), .Cells(.Cells.Find("*", , , , 1, 2).Row, .Cells.Find("*", , , , 2, 2).Column)).Value
End With
ReDim outArr(1 To UBound(inArr) * UBound(inArr, 2))
k = 1
For j = 1 To UBound(inArr, 2)
For i = 1 To UBound(inArr)
k = k + 1
arrayToWrite(k) = budgets(i, j)
Next i
Next j
Sheet6.Range("E2:E" & UBound(arrayToWrite)).Value = Application.Transpose(arrayToWrite)
End Sub
And if you want each row transposed and below each other than simply switch the two For...-lines. (Still the code does basically the same like before)
If I wish to take an array and enter it into an Excel worksheet, how do I do that?
If I use my code below, they go into the wrong cell (G5 instead of F4) and cut off the last column and row of the array.
I can add 1 to each of the resize dimensions (which will give me all the values I need), but then the data still only starts in G5 rather than F4. How can I get the data to begin from F4? (I've condensed the problem to this from a much larger spreadsheet where I'm not able to just simply use the next cell). Code is as follows:
Public ArrayToPaste(4, 2) As Variant
Sub PasteTheArray()
Dim i, j As Integer
For i = 1 To 2
For j = 1 To 4
ArrayToPaste(j, i) = Cells(j, i).Value
Next j
Next i
Range("F4").Resize(UBound(ArrayToPaste, 1), UBound(ArrayToPaste, 2)) = ArrayToPaste
End Sub
You were very close:
Public ArrayToPaste(1 To 4, 1 To 2) As Variant
Sub PasteTheArray()
Dim i, j As Integer
For i = 1 To 2
For j = 1 To 4
ArrayToPaste(j, i) = Cells(j, i).Value
Next j
Next i
Range("F4").Resize(UBound(ArrayToPaste, 1), UBound(ArrayToPaste, 2)) = ArrayToPaste
End Sub
Just make ArrayToPaste 1-based rather than 0-based.
I'm trying to cumulate the sums of values in an excel column of 4 values dimension (4,1).
So, I constructed the code below. For the first row in a column on the side Result, it is supposed to hold the same value as in the original Array.
But then, once it is greater than the first row, it is supposed to get the previous element of result (i-1) and add to it the current column element (i).
VBA is telling me that the subscript is out of range :/ and I cant figure out why... so I dont even know if my code does what I want.
Sub CumulativeSum()
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
For i = 1 To 4
result(1) = rColumn(1, 1)
For j = 2 To 3
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Next i
Dim dest As Range
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = result
End Sub
Sub CumulativeSum()
Dim dest As Range
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
result(1) = rColumn(1, 1)
For j = 2 To 4
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = Application.Transpose(result)
End Sub
Don't have enough rep to add a comment but.. the reason why you're getting an error is because the Syntax for Cells is Cells([Row],[Column]). You're typing it in as Cells([Column],[Row]).
Try Range(Cells(1, 5), Cells(4, 5)) instead.