Efficient way to group objects in an Array

Question

I have an Array of user defined Objects. Lets say the classy, dogs. Now I need a way to only look at all brown dogs with spots (both attributes of the Object).

I could create a new array "brown dogs" go through the original array take each dog that has brown fur and pack him in the new array. Then do another array "brown, spotted dogs" and so on you get the idea... Works but isnt really great.

But I actually need to look at all dogs with each possible color, so all brown dogs in a group, all white dogs etc. And then create further sub groups based on further attributes.

It would be easy in an excel sheet, just filter for brown, and the other attribute, then ran the macro you want, then (by hand) filter to another color, ran code again...

I have a construct in mind that could do that in theory (take value of first attribute, create "already done colors" array, put it in their, go through whole original array, find all with the same color and then do this over and over again for all subsequent attributes) But this would be just very complexe, and hard to maintain. Isnt their an easier and quicker option to only a specific subset of values of the array (brown dogs) and repeat it for all permutations of that attribute?

Maybe this picture helps to illustrate the idea:

The basic challange is: find if the the combination of b-z (in column 2 and 3) exists for each group of column 1.

A human sees quiet quickly that for group "1" (blue) in column 1 there are 2 cases of b-z (Rows 5 and 7) but none for group "2" (green).

A programm would need to find all instances where column one is of the first value ("2") and then find all other rows with this value (rows 2,5 and 6) then for this list check column 2 and 3.

Go to the next row and check if attribute 1 was already used (it wasnt, its "1" in line two and was "2" in line one) and then compare again.

This may be doable for the given example but gets burdensome when you have several stages of grouping. So first group for Attribute one, then for ( a hyphotetical) attribute 4 and attribute 5 and then for this sub group check columns 2 an d 3 values.

Iam now looking for a way to do this "grouping" in a more managable way, is there any option for this?

Code example for what I think is a not so great version for grouping/filtering this:

dim ArrayofObjectInstances() as SpecificObject
dim ArrAlreadyUsedIds() as integer
dim ArrayOfObjectsWithSameID() as SpecificObject

For each element in ArrayofObjectInstances
If not IsinArray(elemnt.ID, ArrAlreadyUsedIds) then

For i = 1 to LenghtOfArray
if ArrayofObjectInstances(i).ID Like element.ID then
'In here I would start the for each and the for loop again for a second Attribute I want to group by, and then again for a third, each time needing more arrays


'fill the "ArrayOfObjectsWithSameID" with the current element (and the first one), then lopp through this array and check 2 Attributes if they are spevific values, 
'just to then be able to say, yes the grouping for this ID has at least one instance where the reuirment is meet
end if
next

end if
next element

Tim Williams · Accepted Answer

One way to go:

Test class clsTest:

Option Explicit

Public Id As Long
Public Color As String
Public Weight As String
Public Attitude As String

'added this for Debug output
Public Property Get AsString()
    AsString = Join(Array(Me.Id, Me.Color, Me.Weight, Me.Attitude), "~")
End Property

Test code:

Option Explicit


Sub Tester()

    Dim i As Long, obj As clsTest, col As New Collection
    
    'create a collection of test objects with randomized property values
    For i = 1 To 10
        Set obj = New clsTest
        obj.Id = i
        obj.Color = Array("Blue", "Brown", "Yellow") _
                         (Application.RandBetween(0, 2))
        obj.Weight = Array("Heavy", "Light")(Application.RandBetween(0, 1))
        
        obj.Attitude = Array("Good", "Bad")(Application.RandBetween(0, 1))
        
        col.Add obj
    Next i
    
    DumpNestedDict Classify(col, Array("Color"))
    
    DumpNestedDict Classify(col, Array("Color", "Weight"))
    
    DumpNestedDict Classify(col, Array("Weight", "Color", "Attitude"))
    
End Sub

'Classify a collection of objects according to an array of property names
'Returns a scripting dictionary (nested if >1 property) with objects
'   contained in one or more collections 
Function Classify(col, arrProps)
    
    Dim dict As Object, pv, i As Long, curr As Object, obj As Object
    
    Set dict = CreateObject("scripting.dictionary")
    
    For Each obj In col
        Set curr = dict 'start at the top level...
        For i = LBound(arrProps) To UBound(arrProps)
            pv = CallByName(obj, arrProps(i), VbGet) 'get the property value
            If Not curr.exists(pv) Then
                If i < UBound(arrProps) Then 'at the last property?
                    'not at last property, so create a nested dictionary
                    curr.Add pv, CreateObject("scripting.dictionary")
                Else
                    'end of the road is a collection of objects
                    curr.Add pv, New Collection 'end of the road is a collection of objects
                End If
            End If
            If i < UBound(arrProps) Then Set curr = curr(pv) 'one level down in the nesting
            
            'last property, so add the object itself
            If i = UBound(arrProps) Then
                curr(pv).Add obj
            End If
        Next i
    Next obj
    
    Set Classify = dict
End Function

'create a text output from a nested dictionary containing collections of objects
'  object must have an "AsString" property
Sub DumpNestedDict(d As Object, Optional level As Long = 0)
    Dim k, v, s, obj
    s = String(level * 3, " ")
    For Each k In d.Keys
        Debug.Print s & "Key:" & k
        If TypeName(d(k)) = "Dictionary" Then
            DumpNestedDict d(k), level + 1
        ElseIf TypeName(d(k)) = "Collection" Then
            For Each obj In d(k)
                Debug.Print String((level + 1) * 3, " ") & obj.AsString
            Next obj
        End If
    Next k
    If level = 0 Then Debug.Print "---------------------------", vbLf
End Sub

Example output:

Key:Yellow
   1~Yellow~Light~Good
   3~Yellow~Light~Bad
   4~Yellow~Heavy~Good
   6~Yellow~Light~Bad
   10~Yellow~Heavy~Good
Key:Brown
   2~Brown~Light~Bad
   7~Brown~Heavy~Bad
   8~Brown~Heavy~Bad
Key:Blue
   5~Blue~Heavy~Bad
   9~Blue~Light~Good
--------------------------- 

Key:Yellow
   Key:Light
      1~Yellow~Light~Good
      3~Yellow~Light~Bad
      6~Yellow~Light~Bad
   Key:Heavy
      4~Yellow~Heavy~Good
      10~Yellow~Heavy~Good
Key:Brown
   Key:Light
      2~Brown~Light~Bad
   Key:Heavy
      7~Brown~Heavy~Bad
      8~Brown~Heavy~Bad
Key:Blue
   Key:Heavy
      5~Blue~Heavy~Bad
   Key:Light
      9~Blue~Light~Good
--------------------------- 

Key:Light
   Key:Yellow
      Key:Good
         1~Yellow~Light~Good
      Key:Bad
         3~Yellow~Light~Bad
         6~Yellow~Light~Bad
   Key:Brown
      Key:Bad
         2~Brown~Light~Bad
   Key:Blue
      Key:Good
         9~Blue~Light~Good
Key:Heavy
   Key:Yellow
      Key:Good
         4~Yellow~Heavy~Good
         10~Yellow~Heavy~Good
   Key:Blue
      Key:Bad
         5~Blue~Heavy~Bad
   Key:Brown
      Key:Bad
         7~Brown~Heavy~Bad
         8~Brown~Heavy~Bad
---------------------------

Efficient way to group objects in an Array

Answers (2)

Related Questions