Excel VBA: Passing a collection from a class to a module issue

Question

Hello,

I have been trying to return a collection from a property within a class to a routine in a normal module. The issue I am experiencing is that the collection is getting populated correctly within the property in the class (FetchAll) but when I pass the collection back to the module (Test) all the entries are populated with the last item in the list.

This is the Test sub-routine in the standard module:

Sub Test()
    Dim QueryType As New QueryType
    Dim Item
    Dim QueryTypes As Collection
    Set QueryTypes = QueryType.FetchAll

    For Each Item In QueryTypes 
        Debug.Print Item.QueryTypeID, _
                    Left(Item.Description, 4)
    Next Item
End Sub

This is the FetchAll property in the QueryType class:

Public Property Get FetchAll() As Collection

    Dim RS As Variant
    Dim Row As Long

    Dim QTypeList As Collection
    Set QTypeList = New Collection

    RS = .Run ' populates RS with a record set from a database (as an array),
                      ' some code removed

    ' goes through the array and sets up objects for each entry
    For Row = LBound(RS, 2) To UBound(RS, 2)
        Dim QType As New QueryType
        With QType
            .QueryTypeID = RS(0, Row)
            .Description = RS(1, Row)
            .Priority = RS(2, Row)
            .QueryGroupID = RS(3, Row)
            .ActiveIND = RS(4, Row)
        End With

        ' adds new QType to collection                
        QTypeList.Add Item:=QType, Key:=CStr(RS(0, Row))

        Debug.Print QTypeList.Item(QTypeList.Count).QueryTypeID, _
                    Left(QTypeList.Item(QTypeList.Count).Description, 4)
    Next Row

    Set FetchAll = QTypeList

End Property

This is the output I get from the debug in FetchAll:

1 Numb
2 PBM 
3 BPM 
4 Bran
5 Claw
6 FA C
7 HNW 
8 HNW 
9 IFA 
10 Manu
11 New 
12 Non 
13 Numb
14 Repo
15 Sell
16 Sms 
17 SMS 
18 SWPM

This is the output I get from the debug in Test:

18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM

Anyone got any ideas? I am probably totally overlooking something!

Thanks, Martin

Answer 1

Your creation of QueryType:

Dim QType As New QueryType

Should be:

Dim QType As QueryType
Set QType = New QueryType

If you don't do this you are reusing the same instance of QueryType (as there is no Set) so the same reference is being added to the collection, making each item reference a single instance of your class. (The last one you added)