Change the Key for an Object in a Collection

I have created a generic function for changing the key for an object in a collection:

 'Module: Module1    Option Explicit    Public Function ChangeKey(Object As Object, NewKey As String, Collection As Collection) As Boolean    Dim Item As Object    Dim Index As Long        For Each Item In Collection            Index = Index + 1            If Item Is Object Then                If Len(NewKey) Then                    Collection.Add Object, NewKey, , Index                Else                    Collection.Add Object, , , Index                End If                Collection.Remove Index                ChangeKey = True                Exit For            End If        Next    End Function'Class: Class1'Collection procedures not used in this example has been removed.     Option Explicit        Private mCol As Collection        Public Function Add(Optional Key As String) As Class2    Dim objNewMember As Class2        Set objNewMember = New Class2                objNewMember.Load Key, mCol                If Len(Key) = 0 Then            mCol.Add objNewMember        Else            mCol.Add objNewMember, Key        End If            Set Add = objNewMember        Set objNewMember = Nothing    End Function        Public Sub Clear()        Do While mCol.Count            mCol.Remove 1        Loop    End Sub        Public Property Get Item(Index As Variant) As Class2        Set Item = mCol(Index)    End Property        Private Sub Class_Initialize()        Set mCol = New Collection    End Sub        Private Sub Class_Terminate()        Clear        Set mCol = Nothing    End Sub'Class: Class2    Option Explicit        Private mKey As String    Private mCol As Collection        Friend Sub Load(Key As String, Col As Collection)        mKey = Key        Set mCol = Col    End Sub        Public Property Get Key() As String        Key = mKey    End Property    Public Property Let Key(vData As String)        If mKey <> vData Then            If ChangeKey(Me, vData, mCol) Then                mKey = vData            Else                Err.Raise vbObjectError + 1, TypeName(Me) & ".Key", "Failed to change key"            End If        End If    End Property'Form: Form1' * Add an Comand ButtonOption ExplicitPrivate Sub Command1_Click()Dim Col As Class1Dim Item1 As Class2Dim Item2 As Class2    Set Col = New Class1        Set Item1 = Col.Add()    Item1.Key = "Test 1"    Set Item1 = Col.Item("Test 1")        Set Item2 = Col.Add("Test2")    Item2.Key = "Test 2"    Set Item2 = Col.Item("Test 2")End Sub

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: