I need to declare variant variables from the elements of a dynamic array.
I have an array (arrWS) which contains the names of specific sheets which is populated manually, and I want to declare "N" range objects where "N" is the number of worksheets.
Sequence:
1- Declare an array containing some worksheet names ==> varAAA = Array("Sheet1", "Sheet3", "Sheet4", ...)
2- Get the number of elements in this array
3- Then like that if possible:
Dim varBBB(1 To N)
For i = 1 to N
varBBB(i) = Sheets(varAAA(i)).UsedRange
Next N
Thank you so much in advance.
Your main problem is that you must Set object variables:
'1- Declare an array containing some worksheet names
' ==> varAAA = Array("Sheet1", "Sheet3", "Sheet4", ...)
Dim VarAAAA
varAAA = Array("Sheet1", "Sheet3", "Sheet4")
'2- Get the number of elements in this array
Dim N As Long
N = UBound(varAAA) - LBound(varAAA) + 1
'3- Then like that if possible:
'Dim varBBB(1 To N)
Dim varBBB() As Range
ReDim varBBB(1 To N)
'For i = 1 to N
For i = 1 To N
'varBBB(i) = Sheets(varAAA(i)).UsedRange
Set varBBB(i) = Sheets(varAAA(i - 1 + LBound(varAAA))).UsedRange
'Confirm that ranges have been correctly set
Debug.Print i, varAAA(i - 1 + LBound(varAAA)), varBBB(i).Address
'Next N
Next
Maybe you are looking for something like,
Dim arrWS() As String
Dim iLoop As Integer
With ThisWorkbook
ReDim arrWS(1 To .Sheets.Count)
For iLoop = 1 To .Sheets.Count
arrWS(iLoop) = .Sheets(iLoop).Name
Next
End With
then you can use Ubound(arrWWS) to get the last index of the array.
You can now use this code to store each usedrange in the sheet,
Dim arrBB() As Variant
Dim arrHolder() As Variant
ReDim arrBB(1 To UBound(arrWS))
For iLoop = LBound(arrWS) To UBound(arrWS)
arrHolder() = Sheets(arrWS(iLoop)).UsedRange.Value
arrBB(iLoop) = arrHolder()
Next
End Sub
You could do this:
Dim varBBB()
Redim varBBB(LBound(varAAA) to UBound(varAAA))
For i = LBound(varAAA) to UBound(varAAA)
varBBB(i) = Sheets(varAAA(i)).UsedRange
Next i
Related
I have 2 arrays taken from 2 ranges in a sheet. I'm trying to create a third array that contains only the values contained in array 1 that are missing in array 2 (I found this code online).
Array 2´s size will vary and depends on this code:
Dim iListaIncompleta() As Variant
Dim iCountLI As Long
Dim iElementLI As Long
iCountLI = Range("B1").End(xlDown).Row
ReDim iListaIncompleta(iCountLI)
For iElementLI = 1 To iCountLI
iListaIncompleta(iElementLI - 1) = Cells(iElementLI, 2).Value
Next iElementLI
and Array 1's size is always from A1:A7, and I use this code to create it:
Dim iListaCompleta() As Variant
Dim iElementLC As Long
iListaCompleta = Range("A1:A7")
This is the original code I found online to extract missing values:
Dim v1 As Variant, v2 As Variant, v3 As Variant
Dim coll As Collection
Dim i As Long
'Original Arrays from the code:
v1 = Array("Bob", "Alice", "Thor", "Anna") 'Complete list
v2 = Array("Bob", "Thor") 'Incomplete list
Set coll = New Collection
For i = LBound(v1) To UBound(v1)
If v1(i) <> 0 Then
coll.Add v1(i), v1(i) 'Does not add value if it's 0
End If
Next i
For i = LBound(v2) To UBound(v2)
On Error Resume Next
coll.Add v2(i), v2(i)
If Err.Number <> 0 Then
coll.Remove v2(i)
End If
If coll.Exists(v2(i)) Then
coll.Remove v2(i)
End If
On Error GoTo 0
Next i
ReDim v3(LBound(v1) To (coll.Count) - 1)
For i = LBound(v3) To UBound(v3)
v3(i) = coll(i + 1) 'Collections are 1-based
Debug.Print v3(i)
Next i
End Sub
However, this code has arrays defined like this:
v1 = Array("Bob", "Alice", "Thor", "Anna")
And the actual arrays I wanna use are defined differently (as you can see in the first two pieces of code). When I try to run the code with them, it displays
Error 9: Subscript out of range.
The code works well as it originally is, but when I try to use MY arrays, it's when I get this error.
Obviously, I've tried it changing the names of the variables (v1 and v2) to my own 2 arrays (iListaCompleta and iListaIncompleta), and still doesn't work.
Any ideas??
Thank you in advance!
Here's a function that can be used to compare arrays of any dimension size to pull out differences and put only the differences in a one-dimensional array:
Public Function ArrayDifference(ByVal arg_Array1 As Variant, ByVal arg_array2 As Variant) As Variant
If Not IsArray(arg_Array1) Or Not IsArray(arg_array2) Then Exit Function 'Arguments provided were not arrays
Dim vElement As Variant
Dim hDifference As Object: Set hDifference = CreateObject("Scripting.Dictionary")
For Each vElement In arg_Array1
If Not hDifference.exists(vElement) Then hDifference.Add vElement, vElement
Next vElement
For Each vElement In arg_array2
If hDifference.exists(vElement) Then
hDifference.Remove vElement
Else
hDifference.Add vElement, vElement
End If
Next vElement
ArrayDifference = hDifference.Keys
End Function
Here's how you would call the function to compare two different arrays. It also includes how to populate the initial arrays using your provided setup:
Sub arrays()
Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet
Dim rList1 As Range: Set rList1 = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim rList2 As Range: Set rList2 = ws.Range("B1", ws.Cells(ws.Rows.Count, "B").End(xlUp))
Dim aList1 As Variant
If rList1.Cells.Count = 1 Then
ReDim aList1(1 To 1, 1 To 1)
aList1(1, 1) = rList1.Value
Else
aList1 = rList1.Value
End If
Dim aList2 As Variant
If rList2.Cells.Count = 1 Then
ReDim aList2(1 To 1, 1 To 1)
aList2(1, 1) = rList2.Value
Else
aList2 = rList2.Value
End If
Dim aList3 As Variant
aList3 = ArrayDifference(aList1, aList2)
MsgBox Join(aList3, Chr(10))
End Sub
I have 2 arrays that I want to combine into a single array of all possible combinations. I then need to loop through all of the combinations and popular arguments for a function. My arrays are not equal in size, and my attempts so far have resulted in a combined array only having 1 pair of values. This is VBA in PowerPoint, not Excel, if that makes a difference to available syntax.
How can I go from this:
arrayColor = Array("Blue","Green","Red")
arraySize = Array("XS","S","M","L","XL")
To this:
arrayCombo(0,0) = "Blue"
arrayCombo(0,1) = "XS"
arrayCombo(1,0) = "Blue"
arrayCombo(1,1) = "S"
...
arrayCombo(15,0) = "Red"
arrayCombo(15,1) = "XL"
And then use a loop to call each pair of values and populate argument values. This code just to illustrate the concept; it's certainly not legit. Pretty sure I need a nested loop here?
For i = 0 To UBound(arrayCombo(i))
nextSubToFire(color, size)
Next i
This is what I've got so far, but it only results in a single pair in my combined array. It's based on this question, but I think I'm either missing something or the sole answer there isn't quite correct. I've looked at other similar questions, but can't wrap my head around doing this with an array compiled in the code rather than the other examples all tailored to Excel.
Option Explicit
Dim arrayColorSize, arrayCombo
Sub CoreRoutine()
Dim arrayColor, arraySize
arrayColor = Array("Blue","Green","Red")
arraySize = Array("XS","S","M","L","XL")
arrayColorSize = Array(arrayColor, arraySize)
arrayCombo = Array(0, 0)
DoCombinations (0)
Dim a As Integer
Dim b As Integer
'For loop comes next once I figure out how to populate the full arrayCombo
End Sub
Sub DoCombinations(ia)
Dim i
For i = 0 To UBound(arrayColorSize(ia)) ' for each item
arrayCombo(ia) = arrayColorSize(ia)(i) ' add this item
If ia = UBound(arrayColorSize) Then
Else
DoCombinations (ia + 1)
End If
Next i
End Sub
Using the Locals window, I see arrayCombo exists, but it only has 1 pair of values in it, which is the last set of pairing options. I see that arrayColorSize has the 2 array sets as I'd expect, so I suspect the DoCombinations sub is missing something.
Any guidance much appreciated!
One way of doing this is to combine the two 1D arrays into a 2D array with 2 columns (as in your example):
Private Function Combine1DArrays(ByRef arr1 As Variant, ByRef arr2 As Variant) As Variant
If GetArrayDimsCount(arr1) <> 1 Or GetArrayDimsCount(arr2) <> 1 Then
Err.Raise 5, "Combine1DArrays", "Expected 1D arrays"
End If
'
Dim count1 As Long: count1 = UBound(arr1) - LBound(arr1) + 1
Dim count2 As Long: count2 = UBound(arr2) - LBound(arr2) + 1
Dim i As Long, j As Long, r As Long
Dim result() As Variant
'
ReDim result(0 To count1 * count2 - 1, 0 To 1)
r = 0
For i = LBound(arr1) To UBound(arr1)
For j = LBound(arr2) To UBound(arr2)
result(r, 0) = arr1(i)
result(r, 1) = arr2(j)
r = r + 1
Next j
Next i
Combine1DArrays = result
End Function
Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
Const MAX_DIMENSION As Long = 60
Dim dimension As Long
Dim tempBound As Long
'
On Error GoTo FinalDimension
For dimension = 1 To MAX_DIMENSION
tempBound = LBound(arr, dimension)
Next dimension
FinalDimension:
GetArrayDimsCount = dimension - 1
End Function
You can use it like this for example:
Sub CoreRoutine()
Dim arrayColorSize As Variant
Dim i As Long
Dim color As String
Dim size As String
'
arrayColorSize = Combine1DArrays(Array("Blue", "Green", "Red") _
, Array("XS", "S", "M", "L", "XL"))
For i = LBound(arrayColorSize, 1) To UBound(arrayColorSize, 1)
color = arrayColorSize(i, 0)
size = arrayColorSize(i, 1)
NextSubToFire color, size
Next i
End Sub
Sub NextSubToFire(ByVal color As String, ByVal size As String)
Debug.Print color, size
End Sub
For any 2-column array A, set every 2nd-column element to be a 1-dimensional array with a size indicated by the first column.
For example: the row [3,""] would become [3,("","","")]
Something like this?
Option Base 1
Sub NestArrays()
Dim OuterArray(3,2) as variant 'create OuterArray with hypothetical numbers 3,5,7
OuterArray(1,1) = 3
OuterArray(2,1) = 5
OuterArray(3,1) = 7
for i = 1 to Ubound(OuterArray) ' for every row in OuterArray
size = OuterArray(i,1) ' set variable "size" equal to the element in 1st column
OuterArray(i,2)=Array(1 to size) ' <--- this doesn't work, set 2nd-col element = array(size)
next i
''''test
OuterArray(1,2)(1) = "aardvark"
debug.print OuterArray(1,2)(1)
End Sub
Use an intermediate array and ReDim as size is dynamic. You possibly want a safeguard on size as well as it needs to be >0 (just a thought)
Option Explicit
Option Base 1
Public Sub NestArrays()
Dim outerArray(3, 2) As Variant, i As Long, size As Long 'create OuterArray with hypothetical numbers 3,5,7
outerArray(1, 1) = 3
outerArray(2, 1) = 5
outerArray(3, 1) = 7
Dim arr()
For i = 1 To UBound(outerArray) ' for every row in OuterArray
size = outerArray(i, 1) ' set variable "size" equal to the element in 1st column
ReDim arr(1 To size)
outerArray(i, 2) = arr
Next i
''''test
outerArray(1, 2)(1) = "aardvark"
Debug.Print outerArray(1, 2)(1)
End Sub
The host array is declared to hold items of type variant. As you can assign an array to a Variant you can proceed as follows
Dim myIndex as long
For Lbound(OuterArray,1) to Ubound(OuterArray,1)
OuterArray(myIndex,2) = Split(String$(OuterArray(myIndex,1),","),",")
Next
If you need the new array to be also an array of variants you will need to create a function that generates the appropriate size of array.
Public Function VarArray(ByVal ipCount As Long) As Variant
Dim mySd As Object
Set mySd = CreateObject("Scripting.DIctionary")
Dim myIndex As Long
For myIndex = 1 To ipCount
mySd.Add myIndex, 0
Next
VarArray = mySd.Items
End Function
So that
OuterArray(myIndex,2) = Split(String$(OuterArray(myIndex,1),","),",")
becomes
OuterArray(myIndex,2) =VarArray(OuterArray(myIndex,1))
I'm trying to create few arrays from named range in my workbook instead of defining that arrays manually.
Example:
This is the array I want to create
Array("bardzo lekka", "lekka", "średnia", "ciężka")
The same data is definied in named range $A$5:$A$8. I want to load that range into array like above.
I've tried to do this like that:
kategoria_a = ActiveWorkbook.Names("kategoria_agronomiczna_gleby").RefersToRange(1, 1)
It creates only one object array.
kategoria_a = ActiveWorkbook.Names("kategoria_agronomiczna_gleby")
That makes
kategoria_a = ='Dane wyjściowe'!$A$5:$A$8
Thanks in advance.
if your values are listed in along a column you could use:
kategoria_a = Application.Transpose(ActiveWorkbook.Names("kategoria_agronomiczna_gleby").RefersToRange.Value)
while if they are listed along a row then you could use
kategoria_a = Application.Transpose(Application.Transpose(ActiveWorkbook.Names("kategoria_agronomiczna_gleby").RefersToRange.Value))
to obtain a 1D array
Try this:
Dim a As Variant
Dim i As Long
Dim rng As Range, r As Range
a = Array("bardzo lekka", "lekka", "średnia", "ciężka")
For i = LBound(a) to UBound(a)
If i = LBound(a) Then
Set rng = Range(a(i))
Else
Set rng = Union(rng, a(i))
End If
Next i
a contains all named ranges. To access the values you could use this:
For Each r In rng
debug.print r.value
Next r
This will take all the named ranges, and put them in an array (myArr):
Sub get_named_ranges()
Dim rng As Range
Dim nm
Dim myArr() As Variant
ReDim myArr(1 To ThisWorkbook.Names.Count)
Dim i As Long
i = 1
For Each nm In ThisWorkbook.Names
myArr(i) = nm.Name
i = i + 1
Next nm
For i = LBound(myArr) To UBound(myArr)
Debug.Print (myArr(i))
Next i
End Sub
If you mean you want to set an array equal to the values in a named range,instead of entering them manually (like your example), then just set the array equal to the range. As long as "kategoria_agronomiczna_gleby" is your named range.
kategoria_a = ActiveWorkbook.Range("kategoria_agronomiczna_gleby")
You can use this loop to check the values in your array
For i = LBound(kategoria_a, 1) To UBound(kategoria_a, 1)
Debug.Print kategoria_a(i, 1)
Next
I'm trying to get a 2D array of size [x][3] filled. X is just the size of the sheet (number of rows) and there are 3 columns which I am interested in. The columns are not near each other, for instance arr[i][0] should be filled from column AA, arr[i][1] should come from column K, and arr[i][2] needs to be from columns L.
I tried assigning it the following way, but got an error in the array value assignment.
Any help on this would be greatly appreciated!
Code:
Sub SOC_work()
'Trying to sort each of the disciplines further, by Stage of Construction
Dim ar_SOC() As Variant
Dim int_NumRows As Long
Dim i_counter As Long
Dim j_Counter As Long
Dim lite As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Sheets("AVEVA_PBOM_PARTS").Select
'Redimension the array size to the amount of parts in the PBOM
int_NumRows = ActiveSheet.UsedRange.Rows.count - 1
ReDim ar_SOC(int_NumRows, 3)
'now assignt he range into the array space
lite = Range("AA2", Range("AA2").End(xlDown))
ar_SOC[][1]=lite
End Sub
Is there any way to do this without looping through the entire column?
As described in the comments, you can fill three 2-D arrays. You can then populate a fourth array from the three arrays, like below.
Sub populateArray()
Dim arrColOne() As Variant, arrColTwo() As Variant, arrColThree() As Variant
Dim arrAllData() As Variant
Dim i As Long
arrColOne = Range("A2:A" & lrow(1)) 'amend column number
arrColTwo = Range("D2:D" & lrow(4))
arrColThree = Range("G2:G" & lrow(7))
ReDim arrAllData(1 To UBound(arrColOne, 1), 2) As Variant
For i = 1 To UBound(arrColOne, 1)
arrAllData(i, 0) = arrColOne(i, 1)
arrAllData(i, 1) = arrColTwo(i, 1)
arrAllData(i, 2) = arrColThree(i, 1)
Next i
End Sub
Public Function lrow(colNum As Integer) As Long
lrow = Cells(Rows.Count, colNum).End(xlUp).Row
End Function
The above will require all 3 columns to be the same length (otherwise populating the last array will not work); this is due to the fourth array being redimensioned to contain the number of elements contained in the first array.
Testing with 250,000 rows of data, the fourth array populated in 0.43 seconds.
How lenient are you with the array you get in return? I can get you a Array(col)(row)-style array, without having to loop to get it, if that works. Note that's not Array(col, row), by the way. It's a single-dimensional array of columns, with each element containing a single-dimensional array of row values. If you're okay with that, you can do this:
Dim a(1 To 3)
a(1) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("AA2:AA10")), 1, 0)
a(2) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("K2:K10" )), 1, 0)
a(3) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("L2:L10" )), 1, 0)
Then you could access your array items like so:
Debug.Print UBound(a) ' Number of columns (3)
Debug.Print UBound(a(1)) ' Number of rows in column 1
Debug.Print a(1)(3) ' Value of column 1 (AA), row 3
The Index() function can return a 1D array but only in the rows direction. So, you need to combine it with Transpose() to return a 1D column array. That's all the code above is doing.
What about an array of arrays?
Sub NoLoop()
Dim R1 As Range, R2 As Range, R3 As Range
Dim Arr1() As Variant, Arr2() As Variant, Arr3() As Variant
Dim LR As Long
LR1 = Cells(Rows.Count, "AA").End(xlUp).Row
LR2 = Cells(Rows.Count, "K").End(xlUp).Row
LR3 = Cells(Rows.Count, "L").End(xlUp).Row
Set R1 = Range(Cells(1, "AA"), Cells(LR1, "AA"))
Set R2 = Range(Cells(1, "K"), Cells(LR2, "K"))
Set R3 = Range(Cells(1, "L"), Cells(LR3, "L"))
Arr1 = R1.Value
Arr2 = R2.Value
Arr3 = R3.Value
ArrArr = Array(Arr1, Arr2, Arr3)
End Sub
With this you can call your values using:
MyVal = ArrArr(0)(1,1)
MyVal = ArrArr(0)(2,1)
MyVal = ArrArr(1)(1,1)
Where the first number is for the array (starts from 0 and ends with 2) and the second number is for row/cell of the range used to fill array.
The third number is always 1 (because adding a range to an array returns a bidimensional array)
With this code you can also have different dimensions for each column so to save memory.