Loading table values inside a collection of class objects-CodePudding

i'm struggling with vba class syntax. I have a table showing me a sort of contacts book, with name, surname, street and zip. When a person has multiple addresses, there is a new row without name and surname but with new street and zip.

I'm trying to store all the data inside a collection with Person and Address class.

Inside my module i try to load the table in the collection. In the first if branch, i make sure that the first cell of the line isn't empty, meaning that it is a new person so i need to create a new collection item. In the else branch i enter when the first cell of the line is empty, meaning that it's just an address that i need to add to the previous collection item. What am i doing wrong?

The code runs correctly on the first iteration of my for cycle but then it gets stuck on the second run of the loop, getting stopped on the class_terminate of my person class.

is it correct the way i store data in the collection?

Address

Option Explicit

Private pStreet As String
Private pZip As Integer

Public Property Let Street(val As String)
   pStreet = val
End Property
Public Property Get Street() As String
   Street = pStreet
End Property
Public Property Let Zip(val As Integer)
   pZip = val
End Property
Public Property Get Zip() As Integer
   Zip = pZip
End Property

Person

Private pName As String
Private pSurname As String
Private pAddresses As New Collection

Public Property Let Name(val As String)
    pName = val
End Property
Public Property Get Name() As String
    Name = pName
End Property

Public Property Let Surname(val As String)
    pSurname = val
End Property
Public Property Get Surname() As String
    Surame = pSurname
End Property

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

Private Sub Class_Terminate()
    Set pAddresses = Nothing
End Sub

Public Sub addAddress(ByVal val As Address)
    pAddresses.Add val
End Sub

Public Property Get Addresses() As Collection
    Set Addresses = pAddresses
End Property

Public Property Get Address(ByVal Index As Long) As Address
    Set Address = pAddresses(Index)
End Property

PersonFactory

Option Explicit

Public Function Create(ByVal Name As String, ByVal Surname As String, ByVal Street As String, ByVal Zip As Integer) As person
   Dim a As Address
   
   Set Create = New person
   Create.Name = Name
   Create.Surname = Surname
   
   Set a = New Address
   a.Street = Street
   a.Zip = Zip
   Create.Addresses.Add a
   
   Set Create = Nothing
   Set a = Nothing
   
End Function

ModuleTest

Private Sub testFilter()

    Dim nameCol, surnameCol, streetCol, zipCol As Integer

    nameCol = 1
    surnameCol = 2
    streetCol = 3
    zipCol = 4

    Dim coll As New Collection
    Sheets.Item("contacts").Select
    
    For i = 2 To getLastRow
        If Cells(i, nameCol).Value <> "" Then
            k = k   1
            Dim pf As PersonFactory
            Dim p As person
            Set pf = New PersonFactory
            Set p = pf.Create(CStr(Cells(i, nameCol).Value), CStr(Cells(i, surnameCol).Value), CStr(Cells(i, streetCol).Value), CInt(Cells(i, zipCol).Value))
            coll.Add p
            
            Set pf = Nothing
            Set p = Nothing
        Else
            Dim addr As Address
            Set addr = New Address
            addr.Street = CStr(Cells(i, streetCol).Value)
            addr.Zip = CInt(Cells(i, streetCol).Value)
            coll.Add addr
            
            Set addr = Nothing
        End If
    Next
End Sub

CodePudding user response：

I did a little refactoring of your test-module - see comments inline

Option Explicit

Private Enum en_colTable
    'value of enums are automatically increased by 1
    'if you change the order the value changes as well
    nameCol = 1
    surnameCol
    streetCol
    zipCol
End Enum


Private Sub testFilter()

    Dim colPersons As New Collection    'this name is more explicit about what the collection is
    
    Dim ws As Worksheet
    Set ws = Thisworkbook.Worksheets.Item("contacts")    'use a worksheet variable to be more explicit
    
    Dim pf As personFactory
    Dim p As person, addr As Address
    
    Set pf = New personFactory  'you need to do this only once
    
    Dim i As Long
    With ws
        For i = 2 To getLastRow
            If .Cells(i, nameCol).Value <> "" Then
                Set p = pf.Create(CStr(.Cells(i, nameCol).Value), _
                                 CStr(.Cells(i, surnameCol).Value), CStr(.Cells(i, streetCol).Value), CInt(.Cells(i, zipCol).Value))
                colPersons.Add p
                
            Else
                Set addr = New Address
                addr.Street = CStr(.Cells(i, streetCol).Value)
                addr.Zip = CInt(.Cells(i, streetCol).Value)
                p.Addresses.Add addr    'add address to person
            End If
        Next
    End With
End Sub

Regarding the ParentFactory: You must not set those created objects to nothing!!!

ParentFactory

Option Explicit

Public Function Create(ByVal Name As String, ByVal Surname As String, ByVal Street As String, ByVal Zip As Integer) As Person
   Dim a As Address
   
   Set Create = New Person
   Create.Name = Name
   Create.Surname = Surname
   
   Set a = New Address
   a.Street = Street
   a.Zip = Zip
   Create.Addresses.Add a
   
' Do not set these variables to nothing - if so they don't exist anylonger!!!!
'   Set Create = Nothing
'   Set a = Nothing
   
End Function