Add range of data/cells in dynamic multidimensional array vba - arrays

I would like to be able to add some range of data in a dynamic multidimensional array without using a double loop that screens each element of the array. But I don't know if it is possible. By double loop, I mean such a code (this is only an example):
Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 2
Films(i, j) = Cells(i, j).Value
Next j
Next i
I am using VBA 2010. I know how many rows my array has, but the number of columns is variable.
Here is my code :
Sub DRS(Item)
'item is a name to search for in a specific range
Dim SrcRange() As Variant
Dim cell3 As Range
Dim n As Integer, m As Integer
SrcRange() = Array()
ReDim SrcRange(45, 0)
m = -1
n = 0
With Sheets("X")
For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
'the range ("I13:AG...") contains names, and some will match with "item"
m = m + 1
If Len(cell3.Value) > 0 And cell3 = Item Then
SrcRange(0, n) = .Range(m + 8 & "30:" & m + 8 & "75")
'the previous line **should** add a whole range of cells (which contain numbers, one by cell) in a colum of the array, but this is the line that doesn't work.
n = n + 1
ReDim Preserve SrcRange(UBound(SrcRange), n)
End If
Next cell3
End With
End Sub
I already tried those::
SrcRange(:, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(0:45, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(, n) = .Range(m + 8 & "30:" & m + 8 & "75")
but no one worked.
Is there a way or a formula that would allow me to add a full range of cells to each column of the array, or am I obliged to use a double loop to add the elements one by one?

I'm guessing that this Range...
.Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
...should actually be xlToLeft instead of xlToRight (xlToRight will always return I13:AG16384).
I'm also not entirely sure what the m + 8 & "30:" & m + 8 & "75" is supposed to be evaluating to, because you increment the variable m each time through the loop, and it gives you ranges like 930:975. I'll take a stab in the dark and assume that the m + 8 is supposed to be the column that you found the item in.
That said, the .Value property of a Range object will just give you a 2 dimensional array. There isn't really any reason to build an array - just build a range and then worry about getting the array out of it when you're done. To consolidate the range (you only get the first area if you grab its Value), just copy and paste it to a temporary Worksheet, grab the array, then delete the new sheet.
Sub DRS(Item)
'item is a name to search for in a specific range
Dim SrcRange() As Variant
Dim found As Range
Dim cell3 As Range
With Sheets("X")
For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToLeft).Column)
'the range ("I13:AG...") contains names, and some will match with "item"
If Len(cell3.Value) > 0 And cell3.Value = Item Then
If Not found Is Nothing Then
Set found = Union(.Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column)), found)
Else
Set found = .Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column))
End If
End If
Next cell3
End With
If Not found Is Nothing Then
Dim temp_sheet As Worksheet
Set temp_sheet = ActiveWorkbook.Sheets.Add
found.Copy
temp_sheet.Paste
SrcRange = temp_sheet.UsedRange.Value
Application.DisplayAlerts = False
temp_sheet.Delete
Application.DisplayAlerts = True
End If
End Sub

Related

How to get index of Element in two dimensional array?

I have an array with 2 dimensions.
I also have a For Each loops which loops with elements of these arrays.
How can i get a Index of vElement/vElement2 in the moment of my comment here in code?
I would be very, very thankful if You can help me.
For Each vElement In Table1
For Each vElement2 In Table2
If ws_1.Cells(1, c) = vElement Then
For Row = 3 To lastRow
amountValue = amountValue + ws_1.Cells(Row, c).value
ws_2.Cells(row2, colIlosc) = amountValue
'Here i would love to have index of vElement for example. In my head it would be something like... Index(vElement) or Index(Table1(vElement))
ws_2.Cells(row2, columncodeprod) = vElement2
row2 = row2 + 1
amountValue = 0
Next Row
End If
Next vElement2
Next vElement
Show Indices of an element in a 2-dim Array - the complicated way
If I understand correctly, you are looping through a datafield array via a ►For Each construction and want to get the current row/column index pair of that same array.
In order to answer your question
"How to get indices of an element in a two dimensional array",
I leave aside that you would get these automatically in a more evident and usual way if you changed the logic by looping through array rows first and inside this loop eventually through array columns - see Addendum *).
To allow a reconstruction of e.g. the 6th array element in the example call below as referring to the current index pair (element i=6 ~> table1(3,2) ~> row:=3/column:=2) it would be necessary
to add an element counter i by incrementing its value by +1 each time you get the next element and
to pass this counter as argument (additionally to a reference to the datafield) to a help function getIndex()
returning results as another array, i.e. an array consisting only of two values: (1) the current array row, (2) the current array column:
Example call
Note: For better readibility and in order to condense the answer to the mimimum needed (c.f. MCVE) the following example call executes only one For Each loop over the table1 datafield array; you will be in the position to change this to your needs or to ask another question.
Option Explicit ' declaration head of your code module
Sub ShowIndicesOf2DimArray()
Dim table1 ' declare variant 1-based 2-dim datafield
table1 = Sheet1.Range("A2:B4") ' << change to sheets Code(Name)
Dim vElem, i As Long
Dim curRow As Long, curCol As Long ' current row/column number
For Each vElem In table1
i = i + 1 ' increment element counter
curRow = getIndex(table1, i)(1) ' <~ get row index via help function
curCol = getIndex(table1, i)(2) ' <~ get col index via help function
'optional debug info in VB Editors immediate window (here: Direktbereich)
Debug.Print i & ". " & _
" Table1(" & curRow & "," & curCol & ") = " & vElem & vbTab;
Debug.Print ", where curRow|curCol are " & Join(getIndex(table1, i), "|")
Next vElem
End Sub
Help function getIndex() called by above procedure
Function getIndex(table1, ByVal no As Long) As Variant
'Purpose: get 1-based 1-dim array with current row+column indices
ReDim tmp(1 To 2)
tmp(1) = (no - 1) Mod UBound(table1) + 1
tmp(2) = Int((no - 1) / UBound(table1) + 1)
getIndex = tmp
End Function
*) Addendum - "the simple way"
Just the other way round using row and column variables r and c as mentioned above; allows to refer to an item simply via table1(r,c) :
Sub TheSimpleWay()
Dim table1 ' declare variant 1-based 2-dim datafield
table1 = Sheet1.Range("A2:B4") ' << change to sheets Code(Name)
Dim vElem, i As Long
Dim r As Long, c As Long ' row and column counter
For r = 1 To UBound(table1) ' start by row 1 (1-based!) up to upper boundary in 1st dimension
For c = 1 To UBound(table1, 2) ' start by col 1 (1-based!) up to upper boundary in 2nd dimension
i = i + 1
Debug.Print i & ". " & _
" Table1(" & r & "," & c & ") = " & table1(r, c) & vbTab;
Debug.Print ", where row|col are " & r & "|" & c
Next c
Next r
End Sub
There is NO index in the case you put in discussion...
vElement and vElement2 variables are of the Variant type. They are not objects, to have an Index property.
When you use a For Each vElement In Table1 loop, VBA starts from the array first element, goes down up to the last row and then do the same for the next column.
When you need to know what you name arrays 'indexes' you must use For i = 1 To Ubound(Table1, 1) followed by For j = 1 To Ubound(Table1, 2). In such a case you will know the matching array element row and columns. We can consider them your pseudo-indexes...
If you really want/insist to extract such indexes in an iteration of type For Each vElement In Table1, you must build them. I will try en elocvent code example:
Sub testElemIndex()
Dim sh As Worksheet, Table1 As Variant, vElement As Variant
Dim i As Long, indexRow As Long, indexCol
Set sh = ActiveSheet
sh.Range("C6").value = "TestIndex"
Table1 = sh.Range("A1:E10").value
For Each vElement In Table1
i = i + 1:
If vElement = "TestIndex" Then
If i <= UBound(Table1, 1) Then
indexRow = i: indexCol = 1
Else
indexCol = Int(i / UBound(Table1, 1)) + 1
indexRow = i - Int(i / UBound(Table1, 1)) * UBound(Table1, 1)
End If
Debug.Print Table1(indexRow, indexCol), indexRow, indexCol: Stop
End If
Next
End Sub
You can calculate the rows and columns of the array element. And the code proves that using them, the returned array value is exactly the found one...
Is it a little more light on the array 'indexes'...?
Dim Table1() As Variant
Dim Table2() As Variant
Table1 = Range(Cells(2, 3), Cells(lastRow, vMaxCol))
Table2 = Range(Cells(2, 1), Cells(lastRow, 1))
Table1 is Variant(1 to 33, 1 to 9)
Table2 is Variant(1 to 33, 1 to 1)
This 33 and 9 is dynamic.

Loop to replicate values into an array

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

using a dictionary and array to count cell values

This is an extension of this question. I want to do something similar, but I am not very familiar with dictionary objects, and the code provided in the answer is very advanced, so I am having trouble understanding it. For instance, some of the syntax is not very clear, and variable names are not very obvious/intuitive. I am creating a new question because the original problem has been solved.
I want to do exactly the same thing as in the linked question, but instead of counting cell values in column H, I want to count AOI entries (and ignore exits) per trial and block in column I, and print the number in column U.
If you could also provide an explanation of the solution to accompany your solution (so that I understand what is going on), that would be appreciated. Or at least explain what is going on in the previous solution.
Here is a link to my most up to date sample data and code.
I've figured it out. Here is the code:
Dim dBT As Object 'global dictionary
Sub buttonpresscount()
'constants for column positions
Const COL_BLOCK As Long = 1
Const COL_TRIAL As Long = 2
Const COL_ACT As Long = 7
Const COL_AOI As Long = 8
Dim rng As Range, lastrow As Long, sht As Worksheet
Dim d, r As Long, k, resBT()
Set sht = Worksheets("full test")
lastrow = Cells(Rows.Count, 3).End(xlUp).Row
Set dBT = CreateObject("scripting.dictionary")
Set rng = sht.Range("B7:I" & lastrow)
d = rng.Value 'get the data into an array
ReDim resBT(1 To UBound(d), 1 To 1) 'resize the array which will
' be placed in ColT
'get unique combinations of Block and Trial and pressedcounts for each
For r = 1 To UBound(d, 1)
k = d(r, COL_BLOCK) & "|" & d(r, COL_TRIAL) 'create key
dBT(k) = dBT(k) + IIf(d(r, COL_ACT) <> "", 1, 0)
Next r
'populate array with appropriate counts for each row
For r = 1 To UBound(d, 1)
k = d(r, 1) & "|" & d(r, 2) 'create key
resBT(r, 1) = dBT(k) 'get the count
Next r
'place array to sheet
sht.Range("T7").Resize(UBound(resBT, 1), 1) = resBT
'clear dictionary
dBT.RemoveAll
'count AOI entries
For r = 1 To UBound(d, 1)
k = d(r, COL_BLOCK) & "|" & d(r, COL_TRIAL) 'create key
dBT(k) = dBT(k) + IIf(d(r, COL_AOI) = "AOI Entry", 1, 0)
Next r
'populate array with appropriate counts for each row
For r = 1 To UBound(d, 1)
k = d(r, 1) & "|" & d(r, 2) 'create key
resBT(r, 1) = dBT(k) 'get the count
Next r
'place array to sheet
sht.Range("U7").Resize(UBound(resBT, 1), 1) = resBT
End Sub
I basically duplicated the previous code, added another constant for the relevant column and changed the relevant references to columns, and made sure to clear the dictionary inbetween counting tasks.

How do I use an array to speed up this process?

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.

Converting an Excel list according to row indexes

I'm trying to convert a list in Excel VBA as follows:
My original list in the one colored in grey. It shows a sequence.
I want to generate the list on the right according to each number location.
For example:
3 is second in the left list so 2 is on the third location in the right list;
6 is fourth in the left list so 4 is on the sixth location in the right list ...
I tried using 'For' loops in VBA, but it's getting a bit long and complex, is there a way to do it by using arrays in VBA?
A formula can easily achieve this. Assuming data is in A1:A8, in B1 and copied down:
=MATCH(ROW(),A$1:A$8,0)
This will work, just set the first, last and ranges as needed.
Private Sub cbSort_Click()
Dim wArray As Variant, dArray As Variant
Dim first As Integer, last As Integer
Dim i As Integer, j As Integer
first = 1
last = 8
Set wArray = Range("A" & first & ":A" & last)
ReDim dArray(1 To last - first + 1, 1 To 1)
j = 1
For i = first To last
dArray(wArray(i, 1), 1) = j
j = j + 1
Next i
Range("B" & first & ":B" & last) = dArray
End Sub
Option Explicit
Sub Main()
Dim source As Range
On Error GoTo ErrTransformIt
Set source = Application.InputBox(prompt:="Source", Type:=8)
TransformIt source
Exit Sub
ErrTransformIt:
MsgBox Err.Description
End Sub
Private Sub TransformIt(ByVal source As Range)
Dim target As Range
Dim c As Range
Dim i As Integer
Dim firstRow As Long
firstRow = source(1).Row
i = 1
For Each c In source.Cells
Set target = ActiveSheet.Cells(firstRow + c.Value - 1, c.Column + 1)
If target.Value <> "" Then
MsgBox "Target is already used by [" & target.Value & "]", vbExclamation
Exit Sub
End If
target.Value = i
i = i + 1
Next c
End Sub

Resources