Using a class of collections to store collection of numbers in a dictionary.

[RawlinsCross]

I have a spreadsheet (clearly) that has rows of numbers under a four categories ("Active", "Lost", Recovered", "Damaged"). These four categories repeat several dozen times across the column space. I want to iterate over the range and save all the individual numbers in all the columns that read each category in an array. The # of rows is variable so I figured I use a collection. But where I have four categories, I figured I'd use a dictionary to store each collection of numbers corresponding to each category. (Hope that was clear).

This is what I've tried but not having much luck. I'm just trying to get it started with the "Active" category and then apply it to the rest.

Class Code

Option Explicit

Public Active As Collection
Public Lost As Collection
Public Recovered As Collection
Public Damaged As Collection

Module Code

Private Sub MakeDictionary()

Dim mlFirstRow As Long, mlLastRow As Long
Dim i As Long, j As Long
Dim sCat As String
Dim C As Collection
Dim moTable As clsTable
Dim mwSht As Worksheet
Dim mrRange As Range
Dim mvMain As Variant

'Testing
mlFirstRow = 2
mlLastRow = 23

Set moTableDict = CreateObject("Scripting.Dictionary")

Set mwSht = ThisWorkbook.Worksheets("Main")
Set mrRange = mwSht.Range("rngMain")
mvMain = mrRange.value

For i = mlFirstRow + 8 To mlLastRow + 8  '8 to account for the header rows in the spreadsheet
    For j = 2 To UBound(mvMain, 2)
        sCat = mvMain(1, j) 'Header column (four categories that repeat)
        With moTableDict
            If Not .Exists(sCat) Then
                Set moTable = New clsTable
                .Add sCat, moTable
                If sCat = "Active" Then
                    Set C = New moTable.Active
                    If IsNumber(mvMain(i, j)) Then
                        C.Add mvMain(i, j)
                    End If
                End If
            Else
                Set moTable = moTableDict(sCat)
                If sCat = "Active" Then
                    Set C = moTable.Active
                    If IsNumber(mvMain(i, j)) Then
                        C.Add mvMain(i, j)
                    End If
                End If
            End If
        End With
    Next j
Next i

Set moTable = moTableDict("Active")
Set C = moTable.Active
Stop

End Sub

 

[shknbk2]

I don't see why you need a dictionary. The class already has the 4 collections. 'C' can be set directly to the relevant class collection without parking the class collection first in the dictionary.

Here is a base code example that I think can be a starting point. I'm not sure if everything works exactly as desired, but stepping through the code may identify where tweaks might be needed.

Class Code (clsTable class module)

Option Explicit

Public Active As Collection
Public Lost As Collection
Public Recovered As Collection
Public Damaged As Collection

Private Sub Class_Initialize()
    Set Active = New Collection
    Set Lost = New Collection
    Set Recovered = New Collection
    Set Damaged = New Collection
End Sub

Module Code

Option Explicit

Private Sub MakeDictionary()

    Dim C As New Collection
    Dim moTable As New clsTable
    
    Dim mlFirstRow As Long, mlLastRow As Long
    Dim i As Long, j As Long
    Dim sCat As String
    Dim C As New Collection
    Dim moTable As New clsTable
    Dim mwSht As Worksheet
    Dim mrRange As Range
    Dim mvMain As Variant
    
    'Testing
    mlFirstRow = 2
    mlLastRow = 23
    
    Set mwSht = ThisWorkbook.Worksheets("Main")
    Set mrRange = mwSht.Range("rngMain")
    mvMain = mrRange.Value
    
    'Start with iterating over columns
    For j = 2 To UBound(mvMain, 2)
        sCat = mvMain(1, j)
        If sCat = "Active" Then
            Set C = moTable.Active
        ElseIf sCat = "Damaged" Then
            Set C = moTable.Damaged
        ElseIf sCat = "Lost" Then
            Set C = moTable.Lost
        ElseIf sCat = "Recovered" Then
            Set C = moTable.Recovered
        End If
        
        'once column is determined and 'C' is assigned, iterate over rows in column
        For i = mlFirstRow + 8 To mlLastRow + 8
            If IsNumber(mvMain(i, j)) Then
                C.Add mvMain(i, j)
            End If
        Next
    Next
    Stop
End Sub

 

[RawlinsCross]

Hey there. My apologies, I haven't been anywhere near a computer of late. Back now.

To clarify the discussion, my data is organized in the form:
WidgetX - Properties of WidgetX - Numbers that go into each Property.

So in terms of the dictionary, the WidgetX (X = 1 to 10 say) is the key, the individual properties of each Widget are collections, and the numbers go into each collection.

 

[shknbk2]

Can you make moTable an array?

Dim moTable(9) As New clsTable

moTable(0) would then have the four collections (active, lost, recovered, damaged) for Widget1, and so on.

 

[RawlinsCross]

Sure, I imagine that's a doable strategy (and perhaps the way to go). But is it not possible, also, to invoke using the dictionary method? Key:=WidgetX Item:=moTable where moTable is the 4-collections class?

 

[shknbk2]

The dictionary should work. How far does the code get if you include the Class_Initialize function in your class and change your module code to this?

Private Sub MakeDictionary()

Dim mlFirstRow As Long, mlLastRow As Long
Dim i As Long, j As Long
Dim sCat As String
Dim C As Collection
Dim moTable As clsTable
Dim mwSht As Worksheet
Dim mrRange As Range
Dim mvMain As Variant

'Testing
mlFirstRow = 2
mlLastRow = 23

Set moTableDict = CreateObject("Scripting.Dictionary")

Set mwSht = ThisWorkbook.Worksheets("Main")
Set mrRange = mwSht.Range("rngMain")
mvMain = mrRange.Value

For i = mlFirstRow + 8 To mlLastRow + 8  '8 to account for the header rows in the spreadsheet
    For j = 2 To UBound(mvMain, 2)
        sCat = mvMain(1, j) 'Header column (four categories that repeat)
        With moTableDict
            If Not .Exists(sCat) Then
                Set moTable = New clsTable
                .Add sCat, moTable
            Else
                Set moTable = moTableDict(sCat)
            End If
            If sCat = "Active" Then
                Set C = moTable.Active
                If IsNumber(mvMain(i, j)) Then
                    C.Add mvMain(i, j)
                End If
            End If
        End With
    Next j
Next i

Set moTable = moTableDict("Active")
Set C = moTable.Active
Stop

End Sub

 

[RawlinsCross]

Okay, let me give that a try and report back. Cheers!