title: Is it possible to access a parent property from a child that is in a collection?
body: <p>I've researched as much as I can and never found a definitive answer on this for VBA.  </p>
  
  <p>This older StackOverflow post has almost everything, but not quite. <a href="https://stackoverflow.com/questions/9686140/excel-vba-classes-how-to-have-a-class-hold-additional-classes">VBA Classes - How to have a class hold additional classes</a></p>
  
  <p>Bottom line - I have a class CClock, which is parent to a Collection of CContacts, which is parent to a CContact.</p>
  
  <p>Is there any way to get at a property of the CClock class from a CContact.  So something like <code>Debug.Print , clsContact.Parent.Parent.Lawyer</code> in the code below?</p>
  
  <p>I've tried setting the parents as I thought they should be but get the below error almost immediately at <code>Set clsClock = New CClock</code>.  When I follow the code it goes to class terminate event in the Contacts collection, which I can't figure out. (Although that is probably why the error below comes up.)</p>
  
  <p><strong><code>91 - Object Variable or With Variable not set</code></strong></p>
  
  <p>The various classes and a quick test rig are below (all based on Dick Kusleika's post in the link.)  Thanks.</p>
  
  <p>(Edit- added the test routine, whooopsy)</p>
  
  <pre><code>Sub test()
  
      Dim i As Long, j As Long
      Dim clsClocks As CClocks
      Dim clsClock As CClock
      Dim clsContact As CContact
  
      Set clsClocks = New CClocks
  
      For i = 1 To 3
          Set clsClock = New CClock
          clsClock.Lawyer = "lawyer " &amp; i
          For j = 1 To 3
              Set clsContact = New CContact
              clsContact.ContactName = "Business Contact " &amp; i &amp; "-" &amp; j
              clsClock.Contacts.Add clsContact
          Next j
          clsClocks.Add clsClock
      Next i
  
      For i = 1 To 2
          Set clsContact = New CContact
          clsContact.ContactName = "Business Contact 66" &amp; "-" &amp; i
          clsClocks(2).Contacts.Add clsContact
      Next i
  
      'write the data backout again
      For Each clsClock In clsClocks
          Debug.Print clsClock.Lawyer
          For Each clsContact In clsClock.Contacts
              Debug.Print , clsContact.ContactName
              Debug.Print , clsContact.Parent.Parent.Lawyer
  
          Next clsContact
      Next clsClock
  
  
  End Sub
  </code></pre>
  
  <p><strong>Clas CClocks</strong></p>
  
  <pre><code>'CClocks
  Option Explicit
  Private mcolClocks As Collection
  Private Sub Class_Initialize()
      Set mcolClocks = New Collection
  End Sub
  Private Sub Class_Terminate()
      Set mcolClocks = Nothing
  End Sub
  Public Property Get NewEnum() As IUnknown
      Set NewEnum = mcolClocks.[_NewEnum]
  End Property
  Public Sub Add(clsClock As CClock)
      If clsClock.ClockID = 0 Then
          clsClock.ClockID = Me.Count + 1
      End If
  
      Set clsClock.Parent = Me
      mcolClocks.Add clsClock, CStr(clsClock.ClockID)
  End Sub
  Public Property Get Clock(vItem As Variant) As CClock
      Set Clock = mcolClocks.Item(vItem)
  End Property
  Public Property Get Count() As Long
      Count = mcolClocks.Count
  End Property
  Public Sub Remove(vItem As Variant)
          clsClock.Remove vItem
  End Sub
  Public Sub Clear()
          Set clsClock = New Collection
  End Sub
  </code></pre>
  
  <p><strong>Class CClock</strong></p>
  
  <pre><code>'CClock
  Private mlClockID As Long
  Private msLawyer As String
  Private mlParentPtr As Long
  Private mclsContacts As CContacts
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
      (dest As Any, Source As Any, ByVal bytes As Long)
  Public Property Set Contacts(ByVal clsContacts As CContacts): Set mclsContacts = clsContacts: End Property
  Public Property Get Contacts() As CContacts: Set Contacts = mclsContacts: End Property
  Public Property Let ClockID(ByVal lClockID As Long): mlClockID = lClockID: End Property
  Public Property Get ClockID() As Long: ClockID = mlClockID: End Property
  Public Property Let Lawyer(ByVal sLawyer As String): msLawyer = sLawyer: End Property
  Public Property Get Lawyer() As String: Lawyer = msLawyer: End Property
  Public Property Get Parent() As CClocks: Set Parent = ObjFromPtr(mlParentPtr): End Property
  Public Property Set Parent(obj As CClocks): mlParentPtr = ObjPtr(obj): End Property
  Private Function ObjFromPtr(ByVal pObj As Long) As Object
      Dim obj As Object
      CopyMemory obj, pObj, 4
      Set ObjFromPtr = obj
      ' manually destroy the temporary object variable
      ' (if you omit this step you'll get a GPF!)
      CopyMemory obj, 0&amp;, 4
  End Function
  Private Sub Class_Initialize()
      Set mclsContacts = New CContacts
      Set Me.Contacts.Parent = Me
  End Sub
  Private Sub Class_Terminate()
      Set mclsContacts = Nothing
  End Sub
  'CContacts
  Option Explicit
  Private mcolContacts As Collection
  Private mlParentPtr As Long
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
      (dest As Any, Source As Any, ByVal bytes As Long)
  Public Property Get Parent() As CClock: Set Parent = ObjFromPtr(mlParentPtr): End Property
  Private Sub Class_Initialize()
      Set mcolContacts = New Collection
  End Sub
  Private Sub Class_Terminate()
      Set mcolContacts = Nothing
  End Sub
  Public Property Get NewEnum() As IUnknown
      Set NewEnum = mcolContacts.[_NewEnum]
  End Property
  Public Sub Add(clsContact As CContact)
      If clsContact.ContactID = 0 Then
          clsContact.ContactID = Me.Count + 1
      End If
      Set clsContact.Parent = Me
      mcolContacts.Add clsContact, CStr(clsContact.ContactID)
  End Sub
  Public Property Get Clock(vItem As Variant) As CContact
      Set Clock = mcolContacts.Item(vItem)
  End Property
  Public Property Get Count() As Long
      Count = mcolContacts.Count
  End Property
  Public Sub Remove(vItem As Variant)
          clsContact.Remove vItem
  End Sub
  Public Sub Clear()
          Set clsContact = New Colletion
  End Sub
  Private Function ObjFromPtr(ByVal pObj As Long) As Object
      Dim obj As Object
      CopyMemory obj, pObj, 4
      Set ObjFromPtr = obj
      ' manually destroy the temporary object variable
      ' (if you omit this step you'll get a GPF!)
      CopyMemory obj, 0&amp;, 4
  End Function
  </code></pre>
  
  <p><strong>Class CContact</strong></p>
  
  <pre><code>'CContact
  Private mlContactID As Long
  Private msContactName As String
  Private mlParentPtr As Long
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
      (dest As Any, Source As Any, ByVal bytes As Long)
  
  Public Property Let ContactID(ByVal lContactID As Long): mlContactID = lContactID: End Property
  Public Property Get ContactID() As Long: ContactID = mlContactID: End Property
  Public Property Let ContactName(ByVal sContactName As String): msContactName = sContactName: End Property
  Public Property Get ContactName() As String: ContactName = msContactName: End Property
  Public Property Get Parent() As CContacts: Set Parent = ObjFromPtr(mlParentPtr): End Property
  Public Property Set Parent(obj As CContacts): mlParentPtr = ObjPtr(obj): End Property
  Private Function ObjFromPtr(ByVal pObj As Long) As Object
      Dim obj As Object
      CopyMemory obj, pObj, 4
      Set ObjFromPtr = obj
      ' manually destroy the temporary object variable
      ' (if you omit this step you'll get a GPF!)
      CopyMemory obj, 0&amp;, 4
  End Function
  </code></pre>