JChristen
JChristen

Reputation: 608

Automatically creating distinct, identifiable collections in VBA, Excel

So I have a large amount of toy trucks, which I have stored in a collection (because at the beginning I don't know how many trucks there will be), and each truck has a lot of properties such as number of sales, price, wheel base etc. One specific property of these trucks is the weight limit, i.e. how much weight this toy can carry, and there are only a certain amount of different weight limits but I don't know how many this will be when I start the macro.

What I want to do is loop through the collection and add the trucks to different collections specific for their weight, but as said above I don't know how many different weight limits there will be.

So I guess my question is how could I go about automatically creating collections that can be identified easily, where each collection is created when a truck with a new weight limit is found looping through all of the trucks?

As an example, if I had 10 trucks and 6 of them could carry 2kg and 4 could carry 3kg, I would want two collections that split the 2kg and 3kg trucks apart.

I've thought about creating a 3 dimensional array but that would involve lots of 'empty space' where some weight limits are more common than others, so more code to deal with that, which isn't ideal. As for creating a jagged array, I run into the same problem about not knowing how to create distinct, easily identifiable arrays automatically.

Ideally what I would like to do is to dynamically create a 2 dimensional array, where the first row is the weight limit and the second row is a reference to a collection (created automatically when new weight limit is added to the array), but I don't think that's possible... (rows containing the weight limits because of ReDim Preserve)

Here's what I'm doing currently, but obviously it's not ideal: (Also, the weight limits do not go up by 2 every time)

For Each v In collTruck
    If v.WeightLimit = 8 Then
        coll8.Add v
    ElseIf v.WeightLimit = 10 Then
        coll10.Add v
    ElseIf v.WeightLimit = 12 Then
        coll12.Add v
    ElseIf v.WeightLimit = 14 Then
        coll14.Add v
    Else: collOtherW.Add v
    End If
Next v

Set collWeights = New Collection
collWeights.Add c8
collWeights.Add c10
collWeights.Add c12
collWeights.Add c14
collWeights.Add cOtherW

Upvotes: 2

Views: 219

Answers (2)

Excel Developers
Excel Developers

Reputation: 2825

Here is how to fill an array with weight limits and collections:

Sub FillArray()

Dim arr() As Variant
Dim col123 As Collection

Set col123 = New Collection
col123.Add 1, "FirstKey"
col123.Add "Whatever", "Foo"

ReDim arr(1 To 2, 1 To 1) As Variant
arr(1, 1) = 1000
Set arr(2, 1) = col123

ReDim Preserve arr(1 To 2, 1 To 2) As Variant
Set col123 = New Collection
col123.Add "Something", "InSomeKey"
col123.Add "Another thing", "In another key"
arr(1, 2) = 2000
Set arr(2, 2) = col123

End Sub

Upvotes: 0

mielk
mielk

Reputation: 3940

Below is the function that takes a collection of trucks as a parameter and returns the collection containing as many subcollections as there is different weight limits. Each such subcollections contains all the trucks with this specific weight limit.

Public Function divideIntoCollections(trucks As Collection) As Collection
    Dim objTruck As Truck
    Dim colWeightGroup As Collection
    Dim weightLimit As Double
    '----------------------------------------------------------------


    Set divideIntoCollections = New Collection


    For Each objTruck In trucks

        weightLimit = objTruck.weightLimit

        'Try to find a subcollection having the same key as the 
        'weight limit of the current truck.
        On Error Resume Next
        Set colWeightGroup = divideIntoCollections.Item(CStr(weightLimit))
        On Error GoTo 0

        'If such subgroup has not been found, it means
        'this is the first truck with such weight limit.
        'We need to create a new subcollection for trucks
        'with such weight limit and add it to the result collection.
        If colWeightGroup Is Nothing Then
            Set colWeightGroup = New Collection
            Call divideIntoCollections.Add(Item:=colWeightGroup, Key:=CStr(weightLimit))
        End If


        'Add current truck to the proper subcollection.
        Call colWeightGroup.Add(Item:=objTruck)


    Next objTruck


End Function

Some examples how to use it:

Sub Main()
    Dim trucks As Collection
    Dim trucksByWeight As Collection
    '--------------------------------------------------

    Set trucks = LoadCollection '<-- your own method to initially
                                '    load trucks into collection.

    Set trucksByWeight = divideIntoCollections(trucks)


    'Here is how you can get access to the trucks with the given weight.
    Dim trucks12 As Collection
    Set trucks12 = trucksByWeight.item("12")


    'Here is how you can print all weight limits and the number of trucks
    'appended to this group.
    Dim subCol As Object
    For Each subCol In trucksByWeight
        Debug.Print " Weight limit: " & subCol.item(1).weightLimit & _
                    " Trucks: " & subCol.Count
    Next item


End Sub

Upvotes: 1

Related Questions