title: Pointers to arrays stored as collection/dictionary items VBA
body: <p>With variant arrays where each element is a double array I am able to do the following:</p>
  
  <pre><code>Public Declare PtrSafe Sub CopyMemoryArray Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination() As Any, ByRef Source As Any, ByVal Length As Long)
  
  Sub test()
      Dim vntArr() as Variant
      Dim A() as Double
      Dim B() as Double
  
      Redim vntArr(1 to 10)
      Redim A(1 to 100, 1 to 200)
      vntArr(1) = A
      CopyMemoryArray B, ByVal VarPtr(vntArr(1)) + 8, PTR_LENGTH '4 or 8
      'Do something
      ZeroMemoryArray B, PTR_LENGTH
  End Sub
  </code></pre>
  
  <p>A and B will then point to the same block in memory. (Setting W = vntArr(1) creates a copy. With very large arrays, I want to avoid this.)</p>
  
  <p>I'm trying to do the same, but with collections:</p>
  
  <pre><code>Sub test()
      Dim col as Collection
      Dim A() as Double
      Dim B() as Double
  
      Set col = New Collection
      col.Add A, "A"
      CopyMemoryArray B, ByVal VarPtr(col("A")) + 8, PTR_LENGTH '4 or 8
      'Do something
      ZeroMemoryArray B, PTR_LENGTH
  End Sub
  </code></pre>
  
  <p>This sort of works, but for some reason the safe array structure (wrapped in Variant data type, similar to the variant array above) returned by col("A") only contains some exterior attributes like number of dimensions and dim boundaries, but the pointer to the <a href="https://msdn.microsoft.com/en-us/library/windows/desktop/ms221482(v=vs.85).aspx" rel="nofollow noreferrer">pvData</a> itself is empty, and so CopyMemoryArray call results in a crash. (Setting B = col("A") works fine.) Same situation with Scripting.Dictionary.</p>
  
  <p>Does anyone know what's going on here? 
  <a href="https://i.stack.imgur.com/G1Wyu.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/G1Wyu.png" alt="enter image description here"></a></p>
  
  <hr>
  
  <p>EDIT</p>
  
  <pre><code>#If Win64 Then
      Public Const PTR_LENGTH As Long = 8
  #Else
      Public Const PTR_LENGTH As Long = 4
  #End If
  
  Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  
  Private Const VT_BYREF As Long = &amp;H4000&amp;
  Private Const S_OK As Long = &amp;H0&amp;
  
  Private Function pArrPtr(ByRef arr As Variant) As LongPtr
      Dim vt As Integer
  
      CopyMemory vt, arr, 2
      If (vt And vbArray) &lt;&gt; vbArray Then
          Err.Raise 5, , "Variant must contain an array"
      End If
      If (vt And VT_BYREF) = VT_BYREF Then
          CopyMemory pArrPtr, ByVal VarPtr(arr) + 8, PTR_LENGTH
          CopyMemory pArrPtr, ByVal pArrPtr, PTR_LENGTH
      Else
          CopyMemory pArrPtr, ByVal VarPtr(arr) + 8, PTR_LENGTH
      End If
  End Function
  
  Private Function GetPointerToData(ByRef arr As Variant) As LongPtr
      Dim pvDataOffset As Long
      #If Win64 Then
          pvDataOffset = 16 '4 extra unused bytes on 64bit machines
      #Else
          pvDataOffset = 12
      #End If
      CopyMemory GetPointerToData, ByVal pArrPtr(arr) + pvDataOffset, PTR_LENGTH
  End Function
  
  Sub CollectionWorks()
      Dim A(1 To 100, 1 To 50) As Double
  
      A(3, 1) = 42
  
      Dim c As Collection
      Set c = New Collection
  
      c.Add A, "A"
  
      Dim ActualPointer As LongPtr
      ActualPointer = GetPointerToData(c("A"))
  
      Dim r As Double
      CopyMemory r, ByVal ActualPointer + (0 + 2) * 8, 8
  
      MsgBox r  'Displays 42
  End Sub
  </code></pre>