Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata

https://stackoverflow.com/a/66208941/5079799

Module:

  • Optional Extra Values, note no "South" for "KL"
  • Values are publicly accessible from another module and stored in memory during excel session
Public mymultivalues As New multivalues
Public Sub CreatemultivaluesCollectionSafer()

    mymultivalues.AddFromValues "WH", "Whitehorse", "North"
    mymultivalues.AddFromValues "YW", "YellowKnife", "North"
    mymultivalues.AddFromValues "KL", "Kamloops"

    Dim tempmultivalue As multivalue

    For Each tempmultivalue In mymultivalues.Items
        Debug.Print tempmultivalue.FullName
    Next tempmultivalue

    Dim primkeyToSearch As String
    
    primkeyToSearch = "KL"
    
    Debug.Print "Primary Key = " & primkeyToSearch
    On Error Resume Next ' If Not Found will Throw Error!
    Debug.Print "KeyValOne = " & mymultivalues.Item(primkeyToSearch).keyvalone
    Debug.Print "FullName = " & mymultivalues.Item(primkeyToSearch).FullName
End Sub
Public Sub TestPublicCollections()
    Dim primkeyToSearch As String
    
    primkeyToSearch = "WH"
    Debug.Print "Primary Key = " & primkeyToSearch
    On Error Resume Next ' If Not Found will Throw Error!
    Debug.Print "KeyValOne = " & mymultivalues.Item(primkeyToSearch).keyvalone
    Debug.Print "FullName = " & mymultivalues.Item(primkeyToSearch).FullName
    Debug.Print "Exists Bool = " & mymultivalues.Exists(primkeyToSearch)
End Sub

multivalue.cls:


Option Explicit

'multivalue Class

Private m_primkey As String
Private m_keyvalone As String
Private m_keyvaltwo As String
Private m_initialized As Boolean

Public Function Init(ByVal primkey_ As String, ByVal keyvalone_ As String, Optional ByVal keyvaltwo_ As String) As Boolean
    If m_initialized Then
        err.Raise 5, TypeName(Me) & ".Init", "Already initialized"
    End If
    If primkey_ = vbNullString Or keyvalone_ = vbNullString Then Exit Function 'Returns False
    
    m_primkey = primkey_
    m_keyvalone = keyvalone_
    m_keyvaltwo = keyvaltwo_
    m_initialized = True
    
    Init = True
End Function

Property Get primkey() As String
    primkey = m_primkey
End Property

Property Get keyvalone() As String
    keyvalone = m_keyvalone
End Property

Property Get keyvaltwo() As String     
    keyvaltwo = m_keyvaltwo
End Property

Property Get FullName() As String
    FullName = m_primkey & " " & m_keyvalone & " " & m_keyvaltwo
End Property

Public Function Self() As multivalue
    Set Self = Me
End Function

multivalues.cls:

Option Explicit

'multivalues Class

Public m_multivalues As New Collection

Public Function Add(ByVal p As multivalue) As Boolean
    On Error Resume Next
    m_multivalues.Add p, p.primkey
    Add = err.Number = 0
    On Error GoTo 0
End Function

Public Function AddFromValues(ByVal primkey_ As String, ByVal keyvalone_ As String, Optional ByVal keyvaltwo_ As String) As Boolean
    With New multivalue
        If Not .Init(primkey_, keyvalone_, keyvaltwo_) Then Exit Function
        AddFromValues = Me.Add(.Self)
    End With
End Function

Public Sub Remove(ByVal indexOrprimkey As Variant)
    m_multivalues.Remove indexOrprimkey
End Sub

Public Property Get Count() As Long
    Count = m_multivalues.Count
End Property

Property Get Item(ByVal indexOrprimkey As Variant) As multivalue
    Set Item = m_multivalues(indexOrprimkey)
End Property

Property Get Items() As Collection
    Set Items = m_multivalues
End Property

Public Function Exists(ByVal primkey_ As String) As Boolean
    On Error Resume Next
    m_multivalues.Item primkey_
    Exists = (err.Number = 0)
    On Error GoTo 0
End Function

https://www.wiseowl.co.uk/blog/s239/collections.htm

Module:

'https://www.wiseowl.co.uk/blog/s239/collections.htm
Sub CreatePersonsCollectionSafer()
 Dim Persons As New clsPersons

 Persons.Add "RitaJ", "Smith"
 Persons.Add "SueB", "Jones"
 Persons.Add "Bob", "Brown"
  
 Dim Person As clsPersons
 Dim PersonNumber As Integer
 Debug.Print Persons.Count
 For PersonNumber = 1 To Persons.Count
  Debug.Print Persons.Item(PersonNumber).FullName
 Next PersonNumber
 
 Dim LastName As String
 LastName = "Brown"
 Debug.Print "Last Name = " & LastName & " & First Name = " & Persons.ItemByLastName(LastName).FirstName
 
 
End Sub

Class (clsPersons):

Option Explicit
Public Persons As New Collection
Private PersonsIndexDic As Object
Public FirstName As String
Public LastName As String
Private Sub Class_Initialize()
 Set PersonsIndexDic = CreateObject("scripting.dictionary")
End Sub
''Subs

Sub Add(FirstName As String, LastName As String)
 Dim p As New clsPersons
 
 p.FirstName = FirstName
 p.LastName = LastName

 Persons.Add p
 
 PersonsIndexDic.Add Key:=LastName, Item:=PersonsIndexDic.Count + 1

End Sub

Sub Remove(NameOrNumber As Variant)
 Persons.Remove NameOrNumber
End Sub
''EndSubs

''Properties
Property Get Count() As Long
 Count = Persons.Count
End Property

Property Get Item(Index As Variant) As clsPersons
 Set Item = Persons(Index)
End Property

Property Get FullName() As String
 FullName = FirstName & " " & LastName
End Property

Property Get Items() As Collection
 Set Items = Persons
End Property

Property Get ItemByLastName(LastName As String) As clsPersons
   Set ItemByLastName = Persons(PersonsIndexDic(LastName))
End Property

''EndProperties

CustomCollections.xlsm

  • No labels