CODEWITHSUNDEEP
vbaexcelcollections
Nyghtprowler
Nyghtprowler

Reputation: 13

Adding a custom class collection to another custom class collection

Ok to start off, I read through this. It is close although it doesn't answer my specific question. This talks about taking smaller collections and adding items to a larger main collection. Then destroying the smaller collection.

I have two definitions under Class Modules.

TimeDet

Option Explicit
Public recDate As String
Public recQty As String
Public recDieNo As String
Public recCatID As String
Public recCatName As String
Public recGroupID As String
Public recGroupName As String

TimeRec

Option Explicit
Private objTimeRec As Collection

Private Sub Class_Initialize()
    Set objTimeRec = New Collection
End Sub

Private Sub Class_Terminate()
    Set objTimeRec = Nothing
End Sub

Public Property Get NewEnum() As IUnknown
    Set NewEnum = objTimeRec.[_NewEnum]
End Property

Public Sub Add(obj As TimeDet)
    objTimeRec.Add obj
End Sub

Public Sub Remove(Index As Variant)
    objTimeRec.Remove Index
End Sub

Public Property Get Item(Index As Variant) As TimeDet
    Set Item = objTimeRec.Item(Index)
End Property

Property Get Count() As Long
    Count = objTimeRec.Count
End Property

Public Sub Clear()
    Set objTimeRec = New Collection
End Sub

Public Sub FillFromArray(Arr As Variant)
    Dim i As Long, obj As TimeDet
    For i = 1 To UBound(Arr)
        Set obj = New TimeDet
        obj.recDate = Arr(i, 1)
        obj.recQty = Arr(i, 2)
        obj.recDieNo = Arr(i, 3)
        obj.recCatID = Arr(i, 4)
        obj.recCatName = Arr(i, 5)
        obj.recGroupID = Arr(i, 6)
        obj.recGroupName = Arr(i, 7)
        Me.Add obj
    Next

End Sub

Then in the code I am using it this way: 

Sub Test()
Dim RecSet1 As TimeRec, Record As TimeDet
Dim fSet1 As TimeRec, fRecord As TimeDet
Dim repArray() As Variant
Dim startDT As Date, endDT As Date, dieNo As String

repArray() = Sheet4.Range("A2:G" & Sheet4.Range("A2").End(xlDown).Row)

Set RecSet1 = New TimeRec
Set fSet1 = New TimeRec

RecSet1.FillFromArray (repArray())

startDT = "1-1-2015"
endDT = "1-1-2016"
dieNo = "16185"

For Each Record In RecSet1
    If Record.recDate <= endDT And Record.recDate >= startDT And Record.recDieNo = dieNo Then
        fSet1.Add (Record)
    End If
Next
End Sub

I am getting an error when I try to add the Record object to the fSet1 object. "Object doesn't support this method or property"

The Record object is Type TimeDet which as you can see up in the class module my Add method is expecting type TimeDet.

Either I am missing something very simple and have blinders on, or this is a bigger issue.

The array has 200,000 records roughly. I am attempting to create a smaller subset of filtered data. Maybe I am approaching this from the wrong way.

Upvotes: 1

Views: 1285

Answers (2)

Nyghtprowler
Nyghtprowler

Reputation: 13

The answer to this particular problem was to remove the parenthesis form my Add method. That being said, the attribute info being hidden was really good info and would have probably contributed to the problem after I figured out that removing the parenthesis fixed it.

Upvotes: 0

cyboashu
cyboashu

Reputation: 10443

Your error is not at Add but at For Each

Most likely you copied your TimeRec Class. In VBA, you can't create enumerable classes inside the VBE (VBA IDE). There's a different way of creating Enumerable classes.

Open a notepad, copy all your class code and then add this attribute to NewEnum property Attribute NewEnum.VB_UserMemId = -4

Then import the class.

This is always hidden in VBA code, but can be seen in text editors. Also add this attribute to Item property, it will make it default and allows syntax like ClassName(1)

Attribute Item.VB_UserMemId = 0

So , your code in text editor/ notepad should be:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private objTimeRec As Collection

Private Sub Class_Initialize()
    Set objTimeRec = New Collection
End Sub

Private Sub Class_Terminate()
    Set objTimeRec = Nothing
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = objTimeRec.[_NewEnum]
End Property

Public Sub Add(obj As Class2)
    objTimeRec.Add obj
End Sub

Public Sub Remove(Index As Variant)
    objTimeRec.Remove Index
End Sub

Public Property Get Item(Index As Variant) As Class2
Attribute Item.VB_UserMemId = 0
    Set Item = objTimeRec.Item(Index)
End Property

Property Get Count() As Long
    Count = objTimeRec.Count
End Property

Public Sub Clear()
    Set objTimeRec = New Collection
End Sub

Upvotes: 1

Related Questions