ArrayList with Arrays - arrays

It seems that more "complex" ArrayLists are not widely used, since I'm unable to find any concrete, helpful info about it.
I'm trying to create an ArrayList of Arrays (and eventually an ArrayList of ArrayLists of Arrays), but I seem unable to either add Arrays to the ArrayList, or access the Array's elements. All this is done using VBScript in QTP.
(The code reads from an Excel file, which is working fine.)
Set my_sheet = ExcelObject.sheets.item(testCaseSheet)
testCase = CreateObject("System.Collections.ArrayList")
Function getTestsCaseActions (row, col)
Do While my_sheet.cells(row, 2).Value <> ""
MsgBox tempArray(0) & " -> " & tempArray(1) 'WORKS FINE - THE VALUES ARE PRINTED
testCase.Add tempArray
row = row+2
Loop
End Function
getTestsCaseActions 3, 4
'This is not working - how do I access the arrays and their values in the arraylist?
For Each ArrayItem in testCase
MsgBox ArrayItem(0)' & ", " & ArrayItem(1)
'MsgBox "Hey!"
Next
Now, I realize that For Each ArrayItem in testCase is probably wrong, but I cannot find out what to use? The elements added to the ArrayList are, after all, Arrays. If I uncomment the line MsgBox "Hey!", it's written once, even though the ArrayList should have 3 Arrays.

Short answer: The correct way to use an ArrayList Of Arrays if you just need read access (after a successful initialization):
Option Explicit
Dim alA : Set alA = CreateObject("System.Collections.Arraylist")
alA.add Split("A B C")
alA.add Split("D E F")
alA.add Split("I J K")
WScript.Echo "---- For Each In"
Dim aX
For Each aX In alA
WScript.Echo TypeName(aX), Join(aX)
Next
WScript.Echo "---- For To"
Dim i
For i = 0 To alA.Count - 1
WScript.Echo TypeName(alA(i)), Join(alA(i))
Next
output:
cscript 19915175.vbs
---- For Each In
Variant() A B C
Variant() D E F
Variant() I J K
---- For To
Variant() A B C
Variant() D E F
Variant() I J K
ReDim Preserve answer(UBound(answer) + 1):
No problems with an ArrayList Of ArrayLists of Arrays (as long we are talking about read access and you don't mess it up):
Dim alB : Set alB = CreateObject("System.Collections.Arraylist")
alB.Add alA
WScript.Echo "alB(0)(0)(0) =>", alB(0)(0)(0)
WScript.Echo "alB(0)(2)(2) =>", alB(0)(2)(2)
output:
alB(0)(0)(0) => A
alB(0)(2)(2) => K

Related

VBA: populate a 2dim array from another 2dim array without nested loop

very new to VBA.
Suppose I have a 6 by 2 array with values shown on right, and I have an empty 2 by 3 array (excluding the header). My goal is to get the array on the left looks as how it is shown.
(Header) 1 2 3 1 a
a c e 1 b
b d f 2 c
2 d
3 e
3 f
Since the array on the right is already sorted, I noticed that it can be faster if I just let the 1st column of the 2 by 3 array take the first 2 values (a and b), the 2nd column takes the following 2 values (c and d), and so on. This way, it can avoid using a nested for loop to populate the left array.
However, I was unable to find a way to populate a specific column of an array. Another way to describe my question is: Is there a way in VBA to replicate this code from python, which directly modifies a specific column of an array? Thanks!
array[:, 0] = [a, b]
Populate Array With Values From Another Array
It is always a nested loop, but in Python, it is obviously 'under the hood' i.e. not seen to the end-user. They have integrated this possibility (written some code) into the language.
The following is a simplified version of what you could do in VBA since there is just too much hard-coded data with 'convenient' numbers in your question.
The line of your interest is:
PopulateColumn dData, c, sData, SourceColumn
to populate column c in the destination array (dData) using one line of code. It's just shorter, not faster.
Sure, it has no loop but if you look at the called procedure, PopulateColumn, you'll see that there actually is one (For dr = 1 To drCount).
You can even go further with simplifying the life of the end-user by using classes but that's 'above my paygrade', and yours at the moment since you're saying you're a noob.
Copy the code into a standard module, e.g. Module1, and run the PopulateColumnTEST procedure.
Note that there are results written to the Visual Basic's Immediate window (Ctrl+G).
The Code
Option Explicit
Sub PopulateColumnTEST()
Const SourceColumn As Long = 2
' Populate the source array.
Dim sData As Variant: ReDim sData(1 To 6, 1 To 2)
Dim r As Long
For r = 1 To 6
sData(r, 1) = Int((r + 1) / 2) ' kind of irrelevant
sData(r, 2) = Chr(96 + r)
Next r
' Print source values.
DebugPrintCharData sData, "Source:" & vbLf & "R 1 2"
' Populate the destination array.
Dim dData As Variant: ReDim dData(1 To 2, 1 To 3)
Dim c As Long
' Loop through the columns of the destination array.
For c = 1 To 3
' Populate the current column of the destination array
' with the data from the source column of the source array
' by calling the 'PopulateColumn' procedure.
PopulateColumn dData, c, sData, SourceColumn
Next c
' Print destination values.
DebugPrintCharData dData, "Destination:" & vbLf & "R 1 2 3"
End Sub
Sub PopulateColumn( _
ByRef dData As Variant, _
ByVal dDataCol As Long, _
ByVal sData As Variant, _
ByVal sDataCol As Long)
Dim drCount As Long: drCount = UBound(dData, 1)
Dim dr As Long
For dr = 1 To drCount
dData(dr, dDataCol) = sData(drCount * (dDataCol - 1) + dr, sDataCol)
Next dr
End Sub
Sub DebugPrintCharData( _
ByVal Data As Variant, _
Optional Title As String = "", _
Optional ByVal ColumnDelimiter As String = " ")
If Len(Title) > 0 Then Debug.Print Title
Dim r As Long
Dim c As Long
Dim rString As String
For r = LBound(Data, 1) To UBound(Data, 1)
For c = LBound(Data, 2) To UBound(Data, 2)
rString = rString & ColumnDelimiter & Data(r, c)
Next c
rString = r & rString
Debug.Print rString
rString = vbNullString
Next r
End Sub
The Results
Source:
R 1 2
1 1 a
2 1 b
3 2 c
4 2 d
5 3 e
6 3 f
Destination:
R 1 2 3
1 a c e
2 b d f
Alternative avoiding loops
For the sake of the art and in order to approximate your requirement to find a way replicating Python's code
array[:, 0] = [a, b]
in VBA without nested loops, you could try the following function combining several column value inputs (via a ParamArray)
returning a combined 2-dim array.
Note that the function
will return a 1-based array by using Application.Index and
will be slower than any combination of array loops.
Function JoinColumnValues(ParamArray cols()) As Variant
'Purp: change ParamArray containing "flat" 1-dim column values to 2-dim array !!
'Note: Assumes 1-dim arrays (!) as column value inputs into ParamArray
' returns a 1-based 2-dim array
Dim tmp As Variant
tmp = cols
With Application
tmp = .Transpose(.Index(tmp, 0, 0))
End With
JoinColumnValues = tmp
End Function
Example call
Assumes "flat" 1-dim array inputs with identical element boundaries
Dim arr
arr = JoinColumnValues(Array("a", "b"), Array("c", "d"), Array("e", "f"))

Check for empty array indexes in VBA (that can include objects)

I need to do a is nothing check on a Variant array to exclude empty indexes from being used. I use is nothing to capture empty indexes which hold (empty) objects, it works fine but for indexes that hold regular data types (not objects), it throws an exception.
Dim arrArray() as Variant
'... fill array with values but leave some indexes out
'Loop through the array
For i = LBound(arrArray) To UBound(arrArray)
'Check if the current array item is an empty object
If arrArray(i) Is Nothing Then
'don't debug.print
'Debug if it's not an empty object
Else
Debug.Print arrArray(i)
End If
Next
I could use on error resume next but since error handling is done dynamically it would change the error handling status so I would like to avoid that. If it can't be avoided please check my other question.
Note: Currently I just work with empty objects, at some point in the future I might get an actual object. So in the long run I will have to check if the index contains an existing object (otherwise - I presume - debug.print will throw an error).
Please, try the next function. It will return a cleaned array (without empty elements) for a wide range of elements type:
Function elimEmptyArrayElements(arrX As Variant) As Variant
Dim i As Long, arrNoEmpty, k As Long
ReDim arrNoEmpty(UBound(arrX)): k = 0
For i = LBound(arrX) To UBound(arrX)
If Not IsMissing(arrX(i)) Then
If Not IsObject(arrX(i)) Then
If TypeName(arrX(i)) = "String" Then
If arrX(i) <> "" Then
arrNoEmpty(k) = arrX(i): k = k + 1
End If
Else
If Not IsEmpty(arrX(i)) Then
arrNoEmpty(k) = arrX(i): k = k + 1
End If
End If
Else
Set arrNoEmpty(k) = arrX(i): k = k + 1
End If
End If
Next i
ReDim Preserve arrNoEmpty(k - 1)
elimEmptyArrayElements = arrNoEmpty
End Function
Please, test it using the next Sub. It will stop on each pair of initial/cleaned array representation. When possible, both arrays are joined in Immediate Window.
If not possible, only the number of their elements (Ubound(arr)) is returned. You may iterate between each array elements and see that no empty one exists:
Sub testElimEmptyArrayElements()
Dim arr
arr = Split("1,7,9,,10,5,6,,2,8,3,4", ",")
Debug.Print Join(arr, "|") 'just to visually see the initial array content
arr = elimEmptyArrayElements(arr)
Debug.Print Join(arr, "|"): Stop 'the cleaned array
arr = Application.Transpose(Range("A2:A20").value) 'a 1D array extracted from a column range
Debug.Print Join(arr, "|")
arr = elimEmptyArrayElements(arr)
Debug.Print Join(arr, "|"): Stop 'the cleaned array
arr = Array(1, 2, 3, , 4, , 5): Debug.Print "Initial number of numeric elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of numeric elements: " & UBound(arr): Stop
arr = Array(Range("A2"), Range("A3"), , Range("A6")): Debug.Print "Initial number of Range Object elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of Range elements: " & UBound(arr): Stop
arr = Array(ActiveSheet, , ActiveSheet.Next): Debug.Print "Initial number of Sheet Object elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of Sheet Object elements: " & UBound(arr): Stop
arr = Array("my string", 100, Range("A2"), , ActiveSheet, , ThisWorkbook, "test", 6): Debug.Print "Initial number of variate elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of variate types elements: " & UBound(arr)
Debug.Print arr(2).value 'the cell value
Debug.Print arr(3).name 'the activesheet name
Debug.Print arr(4).Sheets.count 'activeworkbook number of sheets
End Sub
You can simply check and filter your array for empty slots with if YourArray(i)<>"" then syntax
Beside that, I see some wrong declaration issues in first line of your code:
1-You can't use Array as a name for your array
2-You should use parentheses after you array name (e.g. Dim myArray() as variant)
3-Variable type can not have parentheses (As far as I know)
I recommend to declare your array like following:
dim arr()
This way it automatically considered as an array of variants. So my suggested code would be like this:
Dim arr()
'... fill array with values but leave some indexes out
For i = LBound(arr) To UBound(arr)
If arr(i)<>"" Then
'do nothing
Else
'do something
end if
Next i

Why does Join() need a double transposition of a 1-dim Long array?

Why does Join() need a double transposition of a 1-dim Long array?
Due to MS Help
the Join() function requires a sourcearray as "one-dimensional array containing substrings to be joined" (btw the help site makes no difference whether it is a Variant or Long).
Note: In the VBE glossary
an array is defined as set of sequentially indexed elements having the same intrinsic data type.
It's no problem to connect 1-dim Variant arrays via Join() and
it's even possible to join numbers as well as they seem to be internally interpreted as "convert us to strings".
Issue with a 1-dim array declared as Long
In some cases I want to restrict the elements type to Long and avoid the Variant solution mentioned above. -
Declaring a "flat" array - here: Numbers() - as Long, however raises Error 5 "Invalid procedure call or argument",
if you try to connect results via a simple
'[2] Failing
Join(Numbers, "|") .
I found an interesting ► work around via a basically redundant double transposition (c.f. [1]),
as it "converts" a flat 1-dim array eventually back to the same dimension.
'[1] work around
Join(Application.Transpose(Application.Transpose(Numbers)), "|")
Question
What's the internal difference how VBA treats both cases and why does Join() need a double transposition of a 1-dim Long array here?
Example call to join a "flat" array declared as Long
In order to show the workaround code line [1] as well as the error raising code line [2],
I integrated a basic error handling showing user defined error lines (ERL), too.
VB Editor's immediate window shows Error 5 in ERL 200:
OK: [1] 3 elems: ~> 100|200|300
ERL: 200 Error No 5 Invalid procedure call or argument
Example call
Sub JoinArr()
Dim Numbers() As Long ' provide for long array Numbers()
FillNumbers 3, Numbers ' call sub procedure to assign 3 numbers to array Nums
' Numbers is now an array of 3 numbers
On Error GoTo oops
'[1] work around - why does Join() need a double transposition in a 1-dim array?
100 Debug.Print " OK: [1] " & UBound(Numbers) & " elems:" & _
" ~> " & Join(Application.Transpose(Application.Transpose(Numbers)), "|")
'[2] join an already existing "flat" array raises Error 5 "Invalid procedure call or argument"
200 Debug.Print " OK [2] " & UBound(Numbers) & " elems:" & _
" ~> " & Join(Numbers, "|")
Exit Sub
oops: Debug.Print "ERL: " & Erl & " Error No " & Err.Number & " " & Err.Description
End Sub
Sub FillNumbers called by above main procedure
Sub FillNumbers(ByVal n As Long, arr)
ReDim arr(1 To n)
arr(1) = 100
arr(2) = 200
arr(3) = 300
End Sub
Trying to Join() an array of Longs will fail:
Sub JoinTestFails()
Dim Numbers(0 To 2) As Long, msg As String
Numbers(0) = 0
Numbers(1) = 1
Numbers(2) = 2
With Application.WorksheetFunction
msg = Join(Numbers, "|")
End With
MsgBox msg
End Sub
The double use of TRANSPOSE() gets around this by generating a one-dimensional, one-based array of Variants:
Sub JoinTest()
Dim Numbers(0 To 2) As Long, msg As String
Numbers(0) = 0
Numbers(1) = 1
Numbers(2) = 2
With Application.WorksheetFunction
Arr = .Transpose(.Transpose(Numbers))
msg = LBound(Arr) & "**" & UBound(Arr) & vbCrLf
msg = msg & Join(.Transpose(.Transpose(Numbers)), "|") & vbCrLf & TypeName(Arr)
End With
MsgBox msg
End Sub
To me, this use of TRANSPOSE is non-intuitive. I would rather make the Variant array with:
Public Function MkVar(arr() As Long) As Variant
' make a variant array from a long array
Dim temp() As Variant, i As Long
ReDim temp(LBound(arr) To UBound(arr))
For i = LBound(arr) To UBound(arr)
temp(i) = arr(i)
Next i
MkVar = temp
End Function
and then:
Sub JoinTest2()
Dim Numbers(0 To 2) As Long, msg As String
Numbers(0) = 0
Numbers(1) = 1
Numbers(2) = 2
arr = MkVar(Numbers)
msg = LBound(arr) & "**" & UBound(arr) & vbCrLf
msg = msg & Join(MkVar(Numbers), "|") & vbCrLf & TypeName(arr)
MsgBox msg
End Sub

How do I make a VB6 variant array with UBound < LBound?

I'm trying to get rid of dependencies on SCRRUN.DLL in a VB6 application. One of the things it's currently being used for is its Dictionary class. The Dictionary class has a Keys function that is supposed to return an array of the keys in the dictionary. I did a little experimentation to see what happens if there are no keys in the dictionary:
Dim D As Dictionary
Set D = New Dictionary
Dim K() As Variant
K = D.Keys
MsgBox LBound(K) & ", " & UBound(K)
I was expecting "subscript out of range", or something similar, but instead I was informed that the LBound is 0 and the UBound is -1.
So, how can I create a Variant array that has LBound 0 and UBound -1?
I've tried just using an uninitialized variant array:
Dim K() as Variant
MsgBox LBound(K) & ", " & UBound(K)
But of course that throws "Subscript out of range", as I would expect. So does erasing an uninitialized array:
Dim K() as Variant
Erase K
MsgBox LBound(K) & ", " & UBound(K)
As does erasing an initialized array:
Dim K() As Variant
ReDim K(0 To 0)
Erase K
MsgBox LBound(K) & ", " & UBound(K)
I also tried just redimming to 0 and -1, strange as that may seem:
Dim K() As Variant
ReDim K(0 To -1)
MsgBox LBound(K) & ", " & UBound(K)
But that also gives "subscript out of range".
Poking around on the web a bit, I found the following trick:
Dim K() As String
K = Split(vbNullString)
MsgBox LBound(K) & ", " & UBound(K)
And that actually does give an array with LBound 0 and UBound -1! Unforunately, it's a String array, whereas I need a Variant array. I can't very well individually copy the Strings from one array to Variants in another array, because, well, 0 to -1 and all.
Does anyone know how to make such an array, Variant() with LBound 0 and UBound -1, without using SCRRUN.DLL? Preferably also using only built-in VB6 stuff, but if you can do it if you're allowed to use some external thing (other than SCRRUN.DLL), I'm all ears. Thanks.
You can use the Array function:
Dim K()
K = Array()
MsgBox UBound(K)
OK, answering my own question (but using OLEAUT32.DLL; I'd still be interested in any solutions that are pure built-in VB6):
Private Declare Function SafeArrayCreateVector Lib "OLEAUT32.DLL" ( _
ByVal vt As VbVarType, ByVal lLbound As Long, ByVal cElements As Long) _
As Variant()
Private Const VT_VARIANT As Long = 12
(...)
Dim K() As Variant
K = SafeArrayCreateVector(VT_VARIANT, 0, 0)
MsgBox LBound(K) & ", " & UBound(K)

VBScript create a multi-dimensional array and add to it?

This is a doozy for me haha, I've pretty much checked nearly every page on Google Search and I still don't quiet understand how to do it.
I want to create a multi dimensional array in VB Script called data2.
Trying the examples that I've seen but I'm getting a "Subscript out of range" error
Dim data2()
sub grabdata
SQL_query = "SELECT * FROM MSAccess_table"
Set rsData = conn.Execute(SQL_query)
Do Until rsData.EOF = True
ReDim Preserve data2(UBound(data2) + 1)
data2(UBound(data2)) = Array(rsData("id"),rsData("column_1"),rsData("column_2"),rsData("column_3"),rsData("column_4"))
rsData.moveNext
Loop
end sub
Basically I'm trying to learn how to make a multi-dimensional array in VB script and add to it with a loop. What are some basic examples that can work in my case?
(1) The best way to get an ADO resultset into a two-dimensional array is to use the .GetRows method. Then your problem just vanishes.
(2) There are two kind of arrays in VBScript. Fixed arrays are declared by specifying their UBounds:
Dim aFix(2, 3)
They can't be resized. Dynamic arrays can be changed by ReDim [Preserve]. The best way to create such an array is
ReDim aDyn(2, 3)
if you know the starting size, or
Dim aDyn : aDyn = Array()
if you want to start with an empty one. The catch 22 is: you can use Preserve only for the last dimension.
(3) Your
Dim data2()
is an abomination - a fixed array of no size. It's a pity that the 'compiler' is too stupid to catch such a beast that VBScript can't handle properly:
>> Dim data2()
>> WScript.Echo UBound(data2)
>>
Error Number: 9
Error Description: Subscript out of range
The nastiness of the Dim a() statement is hidden by the fact that a later ReDim will store a proper dynamic array into that variable:
>> Dim data2() ' <-- abomination
>> ReDim data2(1,1) ' <-- overwritten by a dynamic array
>> data2(0,0) = 0
>> ReDim Preserve data2(1,5) ' last dimension increased; 'old' data preserved
>> data2(1,5) = 1
>> WScript.Echo data2(0,0), data2(1,5)
>>
0 1
Update wrt jmbpiano's comment:
(1) I gave evidence that you can't get the UBound for a variable dimmed with (), so I stick to my claim that such beasts are abominations. Just look at the question (or this one) to see that using the () will give you trouble.
(2) I said that you should use ReDim a(KnownUbound) to 'declare' a dynamic array with known size, but I didn't give evidence for the 'Option Explicit'-compatibility of this idiom. So :
Option Explicit
ReDim a(4711)
ReDim b(4,7,1,1)
a(0) = "qed"
b(0,0,0,0) = "qed"
WScript.Echo b(0,0,0,0)
output:
cscript 19888987.vbs
qed
This may be off-topic, but after seeing your exact code, why aren't you using the built-in ADO function: GetRows() ?
sub grabdata
SQL_query = "SELECT * FROM MSAccess_table"
Set rsData = conn.Execute(SQL_query)
If Not rsData.EOF Then aData = rsData.GetRows()
end sub
This returns all your column # as the first index, and the rows (data) in the second.
So to loop through it, you would:
If IsArray(aData) Then
For x = lBound(aData,2) to uBound(aData,2) 'loops through the rows
Col1 = aData(0,x)
Col2 = aData(1,x)
Col3 = aData(2,x)
Response.Write "Row #" & x+1 & "<br>"
Response.Write "This is the data in Column1: " & Col1 & "<br>"
Response.Write "This is the data in Column2: " & Col2 & "<br>"
Response.Write "This is the data in Column3: " & Col3 & "<br>"
Next
End If
*NOTE: Rows (and columns) start on 0 in the array by default.
set rs = conn.execute(strQry)
arrRAY = rs.GetRows()
if isarray(arrRAY) then
do stuff
end if

Resources