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.
Related
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)
I’m in a situation where I need to reproduce something in VBA and a bit stuck given my lack of understanding of object oriented language and VBA in general.
Problem:
I need to produce an array or vector based on a 2 column table.
The first range (column) contains unit counts.
The second range (column) contains numeric values.
I need to replicate the value based on the number of units.
For example,
if the first row contains 3 units with a value of $100
I need the array to contain $100, $100, $100.
This will need to be looped thru each row containing units.
So if row 2 contains 2 units with a value of $50
I need to complete array to be $100, $100, $100, $50, $50, and so on.
I understand this situation will require ReDim the array based on the total values. My struggle is I’ve been unable to figure out the nested for loops.
I get how to replicate the value based on the number of “units” like the below...
ReDim arr(0 To x - 1)
For i = 0 To x - 1
arr(i) = rng.Offset(0, 1).Value
Next
What is the best way to loop thru each row and replicate the values for each row in the range based on the unit count?
If anyone is familiar with R, I'm essentially looking for something that achieves the rep() function (e.g., rep(df$b, df$a)) and return the values in a single array.
Any help is greatly appreciated. Thanks
Or a one liner which uses the REPT function as you would have used in r :)
This assumes your data is in A1:B10 - the length can be made variable
s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")
An an example, to dump the new to array to C1
s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")
[c1].Resize(UBound(s), 1) = Application.Transpose(s)
When you say Row contains 3 units, do you mean the cell has value 3 or 3 Units? If it is 3 then you may not have to Redim the array in the loop. Simply find the sum of values in Col A which has units and Redim it in one go as shown below.
Sub Sample()
Dim ws As Worksheet
Dim Ar() As String
Dim n As Long, i As Long, lRow As Long
'~~> Change this to the relevant sheet
Set ws = Sheet6
With ws
n = Application.WorksheetFunction.Sum(.Columns(1))
ReDim Ar(t To n)
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
n = 1
For i = 1 To lRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
For j = 1 To .Range("A" & i).Value
Ar(n) = .Range("B" & i).Value
n = n + 1
Next j
End If
Next i
For i = LBound(Ar) To UBound(Ar)
Debug.Print Ar(i)
Next i
End With
End Sub
Screenshot
And if the cell has 3 Units then you will have to store the values of Col A in an array, do a replace on Unit/Units, find the sum and finally use the above code. Here is an example
Sub Sample()
Dim ws As Worksheet
Dim Ar() As String, tmpAr As Variant
Dim n As Long, i As Long, j As Long, k As Long, lRow As Long
'~~> Change this to the relevant sheet
Set ws = Sheet6
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
tmpAr = .Range("A1:A" & lRow).Value
For i = LBound(tmpAr) To UBound(tmpAr)
tmpAr(i, 1) = Replace(tmpAr(i, 1), "Units", "")
tmpAr(i, 1) = Trim(Replace(tmpAr(i, 1), "Unit", ""))
n = n + Val(tmpAr(i, 1))
Next i
ReDim Ar(t To n)
n = 1
For i = 1 To lRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
k = Val(Trim(Replace(Replace(.Range("A" & i).Value, "Units", ""), "Unit", "")))
For j = 1 To k
Ar(n) = .Range("B" & i).Value
n = n + 1
Next j
End If
Next i
For i = 1 To UBound(Ar)
Debug.Print Ar(i)
Next i
End With
End Sub
Screenshot
if your data is already in an array then ReDim'ing will delete it's contents. You can ReDim Preserve but it's an expensive operation, better to create a new array to put the results into.
I have assumed the data is contained within a Named Range called "Data" with Units being the first column and Values being the second column.
if your data changes regularly you can create a dynamic range using the OFFSET function i.e. =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),2) assuming your data starts in cell A1 and there is no header row.
Sub ProcessData()
Dim DataArr() As Variant
Dim QtyColArr() As Variant
Dim ResultArr() As Variant
Dim TotalQty As Long
Dim i As Long, j As Long, k As Long
'store data into array
DataArr = Range("Data") 'assume data stored in named range called "Data"
'store Qty col into 1D array
QtyColArr = Range("Data").Resize(, 1)
'sum all qty vals
TotalQty = Application.Sum(QtyColArr)
're-size ResultsArray
ReDim ResultArr(1 To TotalQty)
'Initialize ResultsArr counter
k = LBound(ResultArr)
'loop DataArr
For i = LBound(DataArr) To UBound(DataArr)
'loop qty for current row
For j = 1 To DataArr(i, 1)
'copy value
ResultArr(k) = DataArr(i, 2)
'iterate ResultsArr counter
k = k + 1
Next j
Next i
'output to intermediate window
Debug.Print "{" & Join(ResultArr) & "}"
End Sub
I have an excel sheet that is formatted like so:
I would like to format it to be something like this:
It is about 40,000 cells of information, so is there any way to do this that isn't manually?
You could probably use =SUMIF to achieve this, since you appear to have numbers as values.
Create a new sheet, copy column A from your data sheet to your new sheet and remove duplicates. Copy row 1 from your data sheet to your new sheet.
Use this formula in sheet 2 cell B2:
=SUMIF(Sheet1!$A:$A;Sheet2!$A2;Sheet1!B:B)
Drag the formula to the right, then down.
I am by no means an excel expert, and this is going to be my first answer ever. Take this into account please.
I've checked it and it works.
I've add a command button in Sheet1 (where the original data is), and when clicked this code writes formatted data into Sheet2.
No need to manually remove duplicates!
Dim dU1 As Object, cU1 As Variant, iU1 As Long, lrU As Long
Dim MyArray() As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim h As Integer
Private Sub CommandButton1_Click()
'Get unique indexes
Set dU1 = CreateObject("Scripting.Dictionary")
lrU = Cells(Rows.Count, 1).End(xlUp).Row 'number of rows
cU1 = Range("A2:A" & lrU) 'Assuming your data starts in A2
For iU1 = 1 To UBound(cU1, 1)
dU1(cU1(iU1, 1)) = 1
Next iU1
'Now dU1 contains indexes as unique values (about, absence, etc.)
For i = 0 To dU1.Count - 1 'for each index
ReDim MyArray(1 To 1) As Variant 'starts a "new" array
For j = 2 To 9 'each of the columns with values (D1-D8)
a = 0
For k = 2 To lrU 'all rows
If (Worksheets("Sheet1").Cells(k, 1).Value = dU1.keys()(i) And Worksheets("Sheet1").Cells(k, j).Value <> "") Then
MyArray(UBound(MyArray)) = Worksheets("Sheet1").Cells(k, j).Value 'add value to array
ReDim Preserve MyArray(1 To UBound(MyArray) + 1) As Variant 'resize array (now is 1 element longer)
a = a + 1
End If
Next
If a = 0 Then 'if no value found, add an element to array anyway
MyArray(UBound(MyArray)) = "" 'add value to array
ReDim Preserve MyArray(1 To UBound(MyArray) + 1) As Variant 'resize array (now is 1 element longer)
End If
Next
Worksheets("Sheet2").Cells(i + 2, 1) = dU1.keys()(i) 'write indexes in another sheet
For h = 2 To UBound(MyArray)
Worksheets("Sheet2").Cells(i + 2, h) = MyArray(h - 1)
Next
Next
End Sub
I want to assign and store two calculated values to a single scenario ("i") in an array. Then I want to dump one of those values (for each "i") in one column and the other value in another column, once the loops are completed. If you look under 'UI, that's what I want to essentially accomplish, but I want them all to spit out at once after the loops are completed, instead of each one spitting out one at a time. I heard an array would be the best/fastest way to do this, but I don't know how to even go about using one.
Thanks
Sub Test_Scenarios()
Dim i As Long, Scenario_Count As Long
Dim j As Integer
'Delete current values on "Testing Output" tab
Sheets("Testing Output").Range("B1:B3").ClearContents
Sheets("Testing Output").Range("A6:AA1000000").ClearContents
'Test scenarios
Scenario_Count = Sheets("Testing Input").Range("B1").Value
For i = 1 To Scenario_Count
For j = 1 To 2
If j = 1 Then Sheets("AA").Range("ZC").Value = "No"
If j = 2 Then Sheets("AA").Range("ZC").Value = "Yes"
Calculate
'UI
If j = 1 Then Sheets("Testing Output").Range("R" & 5 + i).Value = Sheets("User Input").Range("B26").Value
If j = 2 Then Sheets("Testing Output").Range("S" & 5 + i).Value = Sheets("User Input").Range("B26").Value
Next j
Next i
End Sub
There's a good discussion of using Arrays to with Excel ranges at http://www.cpearson.com/excel/ArraysAndRanges.aspx, but I'll include some basics here.
To read data from an Excel Range in to an array:
Dim Arr() As Variant
Arr = Range("A1:B10")
To write data from an array to an Excel Range:
Range("E1:F10").Value = Arr
When writing the array back to the range, the size of the array must match the size of the Range. You can check the size of the array using UBound:
myRange.Resize(UBound(Arr, 1), UBound(Arr, 2))
You access data in the array by specifying the position in each dimension:
Arr(2, 3) = 7
Edit due to extra info about the question:
The example below creates an empty array and sizes it according to the number of scenarios, then stores values as it goes through the loop. The values from the loop are written to the output range after the loops are complete:
Option Base 1
Sub Test_Scenarios()
Dim i As Long, Scenario_Count As Long
Dim j As Integer
'Delete current values on "Testing Output" tab
Sheets("Testing Output").Range("B1:B3").ClearContents
Sheets("Testing Output").Range("A6:AA1000000").ClearContents
'Test scenarios
Scenario_Count = Sheets("Testing Input").Range("B1").Value
Dim arr() As Variant
ReDim arr(Scenario_Count, 2)
Dim outputRange As Range
Set outputRange = Sheets("Testing Output").Range("R5")
Set outputRange = outputRange.Resize(Scenario_Count, 2)
For i = 1 To Scenario_Count
For j = 1 To 2
'Calculate
Sheets("User Input").Range("B26").Value = Sheets("User Input").Range("B26").Value + i + j
'UI
arr(i, j) = Sheets("User Input").Range("B26").Value
Debug.Print "i: " & i & " j: " & j & " value: " & arr(i, j)
Next j
Next i
outputRange.Value = arr
End Sub
The loops are still reading and writing to the spreadsheet, as we don't have any other information about the calculations.
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.