is it possbile to create an collection of arrays in vba?

Question

first of all, i'd like to say, i've sarched thorugh the net, but i haven't run into such a thing. i've seen collection of collections, or array of arrays, but not a collection of array.

what i want to do is, to collect ID's in collections for each District. Finally, i will join the values in the collections with Join function and ";" as delimiter, and then print them in a range of 4 column as a lookup list, for each class. For example;

Class2(0) will include 54020 and 30734, class2(1) will include 58618, class1(4) will include none, class3(7) will include 35516,34781 and 56874, and so on.

i want to loop through column C and put a select case statment to check the class and then assign the values to collections

Sub dict_coll()
Dim class1() As New Collection
Dim class2() As New Collection
Dim class3() As New Collection
Dim class4() As New Collection

Dim dict As New Scripting.Dictionary

Set dRange = range(range("a2"), range("a2").End(xlDown))

i = 0
For Each d In dRange
    If Not dict.Exists(d.Value) Then
        dict.Add key:=d.Value, item:=i
        i = i + 1
    End If
Next d

Set cRange = range(range("c2"), range("c2").End(xlDown))
For Each c In cRange
    Select Case c.Value
        Case "class1"
            class1(dict(c.offset(0,-2).value)).Add c.Offset(0, 1).Value 'fails here
        Case "class2"
            class2(dict(c.offset(0,-2).value)).Add c.Offset(0, 1).Value 'fails here
        Case "class3"
            class3(dict(c.offset(0,-2).value)).Add c.Offset(0, 1).Value 'fails here
        Case Else
            class4(dict(c.offset(0,-2).value)).Add c.Offset(0, 1).Value 'fails here
    End Select
Next c
End Sub

and what i want to see is as foloowing: is there any easier and proper way of what i wanna do? any help wil be appreciated.

thanks

Answer 1

by the way, i've found another solution, usinf both dictionary and 3-dimension array.

Sub test()
Dim Blg As New Scripting.Dictionary
Dim Sgm As New Scripting.Dictionary
Dim Siciller() As String

ReDim Siciller(0 To 23, 0 To 3, 0 To 5)

Set alanBolge = range(range("a2"), range("a2").End(xlDown))
Set alanSegment = range(range("c2"), range("c2").End(xlDown))

i = 0
For Each d In alanBolge
    If Not Blg.Exists(d.Value) Then
        Blg.Add Key:=d.Value, item:=i
        i = i + 1
    End If
Next d

k = 0
For Each d In alanSegment
    If Not Sgm.Exists(d.Value) Then
        Sgm.Add Key:=d.Value, item:=k
        k = k + 1
    End If
Next d



'data reading
For Each d In alanBolge
    Siciller(Blg(d.Value), Sgm(d.Offset(0, 2).Value), dolusay(Siciller, Blg(d.Value), Sgm(d.Offset(0, 2).Value)) + 1) = d.Offset(0, 1).Value
Next d


'output
For x = 1 To 4
    For y = 1 To 24
        Set h = Cells(1 + y, 5 + x)
        h.Select
        h.Value = sonucgetir(Siciller, Blg(h.Offset(0, -x).Value), Sgm(h.Offset(-y, 0).Value))
    Next y
Next x


End Sub
Public Function dolusay(ByVal data As Variant, ByVal i1 As Integer, ByVal i2 As Integer) As Integer
    Dim count As Integer
    count = 0

    For j = 0 To UBound(data, 3) - 1
        If Len(data(i1, i2, j)) > 0 Then
            count = count + 1
        End If
    Next
    dolusay = count
End Function
Public Function sonucgetir(ByVal data As Variant, ByVal i1 As Integer, ByVal i2 As Integer) As String
    sonucgetir = ""
    For i = 0 To UBound(data, 3)
        If Len(data(i1, i2, i)) > 0 Then
            x = data(i1, i2, i) & ";" & x
            sonucgetir = Left(x, Len(x) - 1)
        End If
    Next i
End Function

Answer 2

I didnt see that sb variable defined in your code.

Anyway, for me I see a case of straightforward arrays: There is fixed dimension of classes so it good enough for me. Furthermore, you can print back to worksheet so easily.

Public Sub test()

  Const strPrefix = "class"

  Dim districtRange As Range, outputRange As Range, r As Range
  Dim arr() As String
  Dim i As Long, j As Long, x As Long, y As Long
  Dim district As String, str As String, idVal As String

  Dim arr2 As Variant

  Application.ScreenUpdating = False

  ReDim arr(1 To 5, 1 To 1)
  arr(1, 1) = "District"
  arr(2, 1) = "Class 1"
  arr(3, 1) = "Class 2"
  arr(4, 1) = "Class 3"
  arr(5, 1) = "Class 4"

  Set districtRange = Range(Range("A2"), Range("C2").End(xlDown))
  arr2 = districtRange.Value
  For x = LBound(arr2, 1) To UBound(arr2, 1)
        district = arr2(x, 1)
        i = Val(Mid(arr2(x, 3), Len(strPrefix) + 1))
        idVal = arr2(x, 2)
        j = inArray(arr, district, 1)       'returns -1 if not found
        If j >= 0 Then
              arr(i + 1, j) = IIf(arr(i + 1, j) = "", idVal, arr(i + 1, j) & ";" & idVal)
        Else
              ReDim Preserve arr(1 To 5, 1 To UBound(arr, 2) + 1)
              arr(1, UBound(arr, 2)) = district
              arr(i + 1, UBound(arr, 2)) = idVal
        End If
  Next x

  Set outputRange = Range("E1")
  outputRange.Resize(UBound(arr, 2), UBound(arr, 1)).Value = Application.Transpose(arr)
  outputRange.Sort Key1:=Range("E1"), Header:=xlYes, Order1:=xlAscending

  Application.ScreenUpdating = True
End Sub

Public Function inArray(arr As Variant, k As String, Optional rowNum As Long, Optional colNum As Long) As Long

  Dim i As Long, j As Long
  inArray = -1

  If rowNum Then
        For i = LBound(arr, 2) To UBound(arr, 2)
              If arr(rowNum, i) = k Then
                    inArray = i
                    Exit Function
              End If
        Next i
  Else
        For i = LBound(arr, 1) To UBound(arr, 1)
              If arr(i, colNum) = k Then
                    inArray = i
                    Exit Function
              End If
        Next i
  End If
End Function