VBA Function - Convert collection to Array help...

[Mallesh23]

Hi Team

Need your help in Converting Collection to Array with the help of function.
how to create two dimension array from collection using Function.

Below is attempted Code
Sub ColltoArray_Help()
 
    Dim arr As Variant
    Dim rg As Range
    Dim Coll As New Collection
    Dim sht As Worksheet
    Set sht = ThisWorkbook.Worksheets(1)
    
    arr = Join(Array("Sachin", "Dhoni"), "!")
    Set rg = sht.Range("A1").CurrentRegion
    
    Dim i As Long
    'Add Data to Dictionary
    
    For i = 2 To rg.Rows.Count
        If InStr(1, arr, rg.Cells(i, 1), vbTextCompare) > 0 Then
            Coll.Add rg.Rows(i).Value
        End If
    Next i


        Dim a As Variant
        a = ColltoArray(Coll)
        
        'Unable to Print getting subscript out of Range
    Sheets("Sheet1").Range("K2").Resize(UBound(a), UBound(a, 2)).Value = a
 
 End Sub

 Function ColltoArray(Coll As Collection) As Variant()
    Dim arr() As Variant
    Dim row As Integer
    Dim c As Variant
    ReDim arr(Coll.Count - 1) As Variant
    
    row = 0
    For Each c In Coll
        arr(row) = c
        row = row + 1
    Next
    ColltoArray = arr
End Function

'-----------------------------------------------------------------
'Working code

Sub test_Array()

Dim ary As Variant, Nary As Variant
Dim c As Long, r As Long, nr As Long


ary = Sheets("Sheet1").Range("a1").CurrentRegion.Value2

ReDim Nary(1 To UBound(ary), 1 To UBound(ary, 2))


For r = 1 To UBound(ary)
    
    If ary(r, 1) = "Sachin" Or ary(r, 1) = "Dhoni" Then
        
        nr = nr + 1
        
        For c = 1 To UBound(ary, 2)
        
            Nary(nr, c) = ary(r, c)
        
        Next c
        
    End If
Next r


Sheets("Sheet1").Range("K2").Resize(nr, UBound(ary, 2)).Value = Nary


End Sub

Dummy Data with expected output

Array_help.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	Name	aaa	bbb	ccc	ddd	eee	fff	ggg		Expected Output	Name	aaa	bbb	ccc	ddd	eee	fff	ggg
2	Sachin	aaa	bbb	ccc	ddd	eee	fff	ggg			Sachin	aaa	bbb	ccc	ddd	eee	fff	ggg
3	Dhoni	aaa	bbb	ccc	ddd	eee	fff	ggg			Dhoni	aaa	bbb	ccc	ddd	eee	fff	ggg
4	Sachin	aaa	bbb	ccc	ddd	eee	fff	ggg			Sachin	aaa	bbb	ccc	ddd	eee	fff	ggg
5	Dhoni	aaa	bbb	ccc	ddd	eee	fff	ggg			Dhoni	aaa	bbb	ccc	ddd	eee	fff	ggg
6	Virat	aaa	bbb	ccc	ddd	eee	fff	ggg			Sachin	aaa	bbb	ccc	ddd	eee	fff	ggg
7	Sachin	aaa	bbb	ccc	ddd	eee	fff	ggg			Dhoni	aaa	bbb	ccc	ddd	eee	fff	ggg
8	Hardik	aaa	bbb	ccc	ddd	eee	fff	ggg
9	Dhoni	aaa	bbb	ccc	ddd	eee	fff	ggg
10	Kapil	aaa	bbb	ccc	ddd	eee	fff	ggg
11	Kapil	aaa	bbb	ccc	ddd	eee	fff	ggg
12	Yuvraj	aaa	bbb	ccc	ddd	eee	fff	ggg
Sheet1

Thanks
mg

 

[Domenic]

The reason you're getting that error is that your variable a has been assigned a one-dimensional array, not a two-dimensional array. As a result, UBound(a, 2) will generate an error.

And, you won't be able to transfer all of the content from a to your worksheet in one go, as you've attempted to do. That's because each element in your one-dimensional array contains a two-dimensional array.

Instead, you'll need to loop through each element in a, and then transfer each array to your worksheet with each iteration.

However, it seems to me that there's no real need to first use a collection and then to transfer the contents to an array.

I would suggest using your working code.

Or is this simply an exercise in learning?

 

[Mallesh23]

Hi Domenic,

Thanks for providing clear information, this is just for learning purpose,

How to Create below function into two dimension array. is it possible?.. and print that array in one line.
or if not possible then how to retrieve data from Array a into Ranges.

Function ColltoArray(Coll As Collection) As Variant()
Dim arr() As Variant
Dim row As Integer
Dim c As Variant
ReDim arr(Coll.Count - 1) As Variant

row = 0
For Each c In Coll
arr(row) = c
row = row + 1
Next
ColltoArray = arr
End Function


Thanks
mg

 

[Domenic]

In that case, ColltoArray() can be amended as follows...

 Function ColltoArray(Coll As Collection) As Variant()
    Dim arr() As Variant
    Dim row As Long
    Dim col As Long
    Dim array_item As Variant
    ReDim arr(Coll.Count - 1, UBound(Coll.Item(1), 2) - 1) As Variant

    row = 0
    For Each array_item In Coll
        For col = 0 To UBound(array_item, 2) - 1
            arr(row, col) = array_item(1, col + 1)
        Next col
        row = row + 1
    Next
    ColltoArray = arr
End Function

Note that arr() has been re-dimensioned as a 0-based, two dimensional array.

Also note that each item in the collection is a 1-based, two dimensional array, and that each element in the array is assigned to their respective row in arr().

By the way, since an Integer data type can only hold values ranging from -32,768 to 32,767, I've declared the variable row as Long to accommodate potentially larger ranges. The Long data type can hold values ranging from -2,147,483,648 to 2,147,483,647.

Then you can use the following line to transfer the contents to your worksheet...

Sheets("Sheet1").Range("K2").Resize(UBound(a) + 1, UBound(a, 2) + 1).Value = a

Note that we add +1 to UBound(a) and UBound(a,2), since a is assigned the 0-based, two-dimensional array returned by ColltoArray().

 

[Mallesh23]

Hi Domenic,

It worked superrrrbbb!! millions of thank you for your help ! you are Genious ! ? ?

Thanks
mg

 

[Domenic]

You're very welcome, I'm glad I could help.

Cheers!