WushuDrew
WushuDrew

Reputation: 31

Dynamically Create collection of Collections VBA

I'm trying to dynamically create a collection with collections nested within. So far, I've been able to create a nested collection by typing everything (see below).

However, I have a (horrible) spreadsheet that has a repeating set of 17 questions hundreds of times in one column, and the answers in the next column. I'm trying to get the answer to each question as an item, and the question itself as the index. The unique set of the 17 questions will be a collection within a collection of the entire spreadsheet. If that doesn't make sense, think about having a collection for each item in a collection.

Here's the collection of collections that is manually typed:

Thanks!

Sub test()
Dim M As New Collection

Dim nst3 As New Collection
Dim nst2 As New Collection
Dim nst1 As New Collection

Dim i As Integer
Dim ii As Integer

nst1.Add "A", "1"
nst1.Add "B", "2"
nst1.Add "C", "3"
nst1.Add "D", "4"

nst2.Add "E", "1"
nst2.Add "F", "2"
nst2.Add "G", "3"
nst2.Add "H", "4"

nst3.Add "I", "1"
nst3.Add "J", "2"
nst3.Add "K", "3"
nst3.Add "L", "4"

M.Add nst1, "Nested_Collection_A"
M.Add nst2, "Nested_Collection_B"
M.Add nst3, "Nested_Collection_C"


For i = 1 To M.Count
    For ii = 1 To M(i).Count
        Debug.Print M(i)(ii)
    Next ii
Next i

End Sub

edit:

In column D, I have these values repeating over, and over for an indeterminate amount of times. And column E has the response.

Date posting/bagging will end?(R)
Date to post/bag location(s)s or meter(s)?(R)
Location 1:
Location 2:
Location 3:
Location 4:
Location 5:
Location 6:
Purpose of Posting/Bagging?
Service Request is from an AMENDED permit(R)?
Side of street to Post/Bag?(R)
Special instructions to Bureau of Traffic Services?
Time posted/bagged begins?(R)
Time posted/baggged ends?(R)
Type of action required?(R)

I'm trying to get a collection of where each question is the index and each answer is the item.

Then, I need a collection of each collection.

Upvotes: 0

Views: 4102

Answers (1)

dnep
dnep

Reputation: 562

I would consider a Dictionary of Collections instead, as with a standard VBA Collection it is not possible to retrieve the list of keys. Suppose you have your list of questions on Col A and answers on Col B, you could do something like:

Sub ReadQuestions()

    Row = 1

    Dim QA As Object
    Set QA = CreateObject("Scripting.Dictionary")

    Dim Ans As Collection

    Do
        'Get Q & A for current row
        question = Cells(Row, 1).text
        answer = Cells(Row, 2).text

        'Tests if last filled row
        If question = "" Then Exit Do

        'If question is duplicate append answer to the current answer collection for that question
        If QA.Exists(question) Then
            QA(question).Add answer
        'If new question, add a collection of answers with one member (so far) to it
        Else
            Set Ans = New Collection
            Ans.Add answer
            Set QA(question) = Ans
        End If

        Row = Row + 1
    Loop

    Set Ans = Nothing


    'Now a simple test

    'Notice that Dictionnary.Keys() is a zero-based array
    FirstQuestion = QA.Keys()(0)
    NAnswers = QA(FirstQuestion).Count
    'On the other hand, Collections are one-based
    FirstAnswer = QA(FirstQuestion).Item(1)

    MsgBox "First question '" & FirstQuestion & "' has " & NAnswers & " answers. The first answer is '" & FirstAnswer & "'"

End Sub

Upvotes: 2

Related Questions