CODEWITHSUNDEEP
excelmultidimensional-arrayvba
CMArg
CMArg

Reputation: 1567

Excel VBA Place values in multidimensional array

I have a worksheet with this type of structure (there are more columns in the real sheet, but not many):

ColumnAValue1   ColumnBValue1   23
ColumnAValue1   ColumnBValue1   45
ColumnAValue1   ColumnBValue1   2.4
ColumnAValue1   ColumnBValue2   1
ColumnAValue1   ColumnBValue2   3
ColumnAValue2   ColumnBValue1   5
ColumnAValue2   ColumnBValue1   6
ColumnAValue2   ColumnBValue1   7
ColumnAValue2   ColumnBValue2   355
ColumnAValue2   ColumnBValue2   221

And I want to get averages, item numbers and deviation for each combination (for example, ColumnAValue1 ColumnBValue1 would be the average of 23, 45 and 2.4). So I thought that getting all data in an Array, or Collection or Dictionary (I don't know if anything like "Multidimensional Dictionary" exists) would be useful. I wanted to end with a multidimentional array (or Collection) with a structure similar to this:

AllData(
        ColumnAValue1(
                    ColumnBValue1(23,45,2.4)
                    ColumnBValue2(1,3)
                    )
        ColumnAValue2(
                    ColumnBValue1(5,6,7)
                    ColumnBValue2(355,221)
                    )
        )

I know how to obtain unique values from columns.

My two questions: 1) How can I create an Array (or Collection) with the proper Keys (ColumnAValue1 and ColumnAValue2 for the first dimention, and ColumnBValue1 and ColumnBValue2 for the second), and 2) then loop through all my data and "place" values in the corresponding subarray.

Upvotes: 1

Views: 546

Answers (1)

GSerg
GSerg

Reputation: 78155

Sub Test()
  Dim c As Collection
  Set c = New Collection

  Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("Sheet1")

  Dim i As Long
  For i = 1 To 10 'Assume 10 rows
    AddToLayeredCollection c, ws.Cells(i, 3).value, ws.Cells(i, 1).value, ws.Cells(i, 2).value 'Assume two columns for keys, A and B
  Next

  'Add 'c' to the watch window and examine it
End Sub

Public Sub AddToLayeredCollection(ByVal root_collection As Collection, ByVal value As Variant, ParamArray keys() As Variant)
  Dim i As Long
  Dim target_collection As Collection

  Set target_collection = root_collection
  For i = LBound(keys) To UBound(keys)
    Set target_collection = ResolveToCollection(target_collection, keys(i))
  Next

  target_collection.Add value
End Sub

Private Function ResolveToCollection(ByVal parent_collection As Collection, ByVal key As Variant) As Collection
  On Error Resume Next
  Set ResolveToCollection = parent_collection(key)(1)
  On Error GoTo 0

  If ResolveToCollection Is Nothing Then
    Set ResolveToCollection = New Collection
    parent_collection.Add Array(key, ResolveToCollection), key
  End If
End Function

The only reason I'm using the Array() thing is to be able to retrieve keys from the collection. You can use Dictionary instead and remove the Array().

Upvotes: 2

Related Questions