0

I am new to Access VBA and I am stuck in what I think a "Language Limitation". I have a collection of Items and I want to copy some of its items in a new collection depending on the condition and then work on that new collection. But the problem is that if I change or remove anything from that new collection, it gets changed in the previous collection also. But I dont want that to happen as it would be again used as it is in next iteration.

The code which I have used to make the new collection is:

Private Function ReturnSubCollection(TotalCollection As Collection, workIDs As String) As Collection
    Dim collWorkIDs As Collection
    Dim itemCount As Integer
    Dim obj As Object
    For itemCount = 1 To TotalCollection.count
        If InStr(1, workIDs, TotalCollection.item(itemCount).Work_ID) > 0 Then
            Set obj = TotalCollection.item(itemCount)
            If collWorkIDs Is Nothing Then Set collWorkIDs = New Collection
            collWorkIDs.Add obj
        End If
    Next

    Set ReturnSubCollection = collWorkIDs
End Function
Erik A
  • 31,639
  • 12
  • 42
  • 67
Hemant Sisodia
  • 488
  • 6
  • 23

1 Answers1

0

This is a limitation of VB. The elegant solution is to create a "memento" class in your item object as mentioned in this great answer.

A simple work around might be this:

Suppose your item class starts with three values Work_ID, Work_Name, Work_Date. Modify your code as follows:

With TotalCollection.item(itemCount)
    If InStr(1, workIDs, .Work_ID) > 0 Then
        Set obj = New itemClass
        obj.Work_ID   = .Work_ID
        obj.Work_Name = .Work_Name
        obj.Work_Date = .Work_Date
        'And so on, for any additional fields.
        If collWorkIDs Is Nothing Then Set collWorkIDs = New Collection
        collWorkIDs.Add obj
    End If
End With

Crude, certainly. Effective, hopefully.

Community
  • 1
  • 1
  • `Dim CTC As CTCDefinitionWrapper For itemCount = 1 To TotalCollection.count With TotalCollection.item(itemCount) If InStr(1, workIDs, .Work_ID) > 0 Then Set CTC = New CTCDefinitionWrapper Set CTC.branchesCollection = .branchesCollection CTC.Work_ID = .Work_ID If collWorkIDs Is Nothing Then Set collWorkIDs = New Collection collWorkIDs.Add CTC End If End With Next` I tried this, but no success. Could you please let me know how to use Memento in this code? – Hemant Sisodia Mar 04 '15 at 06:46
  • I don't think I can say it any better than the guy in the link I gave. When you go to that page, scroll down to where it says "EDIT: Problem Solved:" His solution is very elegant and succinct. – David McElhaney Mar 04 '15 at 08:37