20

Is there any way to copy an array reference in VBA (or VB6)?

In VBA, arrays are value types. Assigning one array variable to another copies the entire array. I want to get two array variables to point to the same array. Is there any way to accomplish this, perhaps using some API memory functions and/or the VarPtr function, which does in fact return the address of a variable in VBA?

Dim arr1(), arr2(), ref1 As LongPtr
arr1 = Array("A", "B", "C")

' Now I want to make arr2 refer to the same array object as arr1
' If this was C#, simply assign, since in .NET arrays are reference types:
arr2 = arr1

' ...Or if arrays were COM objects:
Set arr2 = arr1

' VarPtr lets me get the address of arr1 like this:
ref1 = VarPtr(arr1)

' ... But I don't know of a way to *set* address of arr2.

Incidentally, it is possible to get multiple references to the same array by passing the same array variable ByRef to multiple parameters of a method:

Sub DuplicateRefs(ByRef Arr1() As String, ByRef Arr2() As String)
    Arr2(0) = "Hello"
    Debug.Print Arr1(0)
End Sub

Dim arrSource(2) As String
arrSource(0) = "Blah"

' This will print 'Hello', because inside DuplicateRefs, both variables
' point to the same array. That is, VarPtr(Arr1) == VarPtr(Arr2)
Call DuplicateRefs(arrSource, arrSource)

But this still does not allow one to simply manufacture a new reference in the same scope as an existing one.

Joshua Honig
  • 12,925
  • 8
  • 53
  • 75
  • While I don't know the answer to your question, I am very interested in the solution... Can you create a Singleton class that holds your array and return the reference via the class? – Marshall May 01 '13 at 18:30
  • Nope. Returning an array from a function or property also operates by value -- returning a new copy of the array. This is actually the real issue I'm trying to address. – Joshua Honig May 01 '13 at 18:37

4 Answers4

24

Yes, you can, if both variables are of type Variant.

Here's why: The Variant type is itself a wrapper. The actual bit content of a Variant is 16 bytes. The first byte indicates the actual data type currently stored. The value corresponds exactly the VbVarType enum. I.e if the Variant is currently holding a Long value, the first byte will be 0x03, the value of vbLong. The second byte contains some bit flags. For exampe, if the variant contains an array, the bit at 0x20 in this byte will be set.

The use of the remaining 14 bytes depends on the data type being stored. For any array type, it contains the address of the array.

That means if you directly overwrite the value of one variant using RtlMoveMemory you have in effect overwritten the reference to an array. This does in fact work!

There's one caveat: When an array variable goes out of scope, the VB runtime will reclaim the memory that the actual array elements contained. When you have manually duplicated an array reference via the Variant CopyMemory technique I've just described, the result is that the runtime will try to reclaim that same memory twice when both variants go out of scope, and the program will crash. To avoid this, you need to manually "erase" all but one of the references by overwriting the variant again, such as with 0s, before the variables go out of scope.

Example 1: This works, but will crash once both variables go out of scope (when the sub exits)

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Sub CopyArrayRef_Bad()
    Dim v1 As Variant, v2 As Variant
    v1 = Array(1, 2, 3)
    CopyMemory v2, v1, 16

    ' Proof:
    v2(1) = "Hello"
    Debug.Print Join(v1, ", ")

    ' ... and now the program will crash
End Sub

Example 2: With careful cleanup, you can get away with it!

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare PtrSafe Sub FillMemory Lib "kernel32" _
    Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)

Sub CopyArrayRef_Good()
    Dim v1 As Variant, v2 As Variant
    v1 = Array(1, 2, 3)
    CopyMemory v2, v1, 16

    ' Proof:
    v2(1) = "Hello"
    Debug.Print Join(v1, ", ")

    ' Clean up:
    FillMemory v2, 16, 0

    ' All good!
End Sub
Joshua Honig
  • 12,925
  • 8
  • 53
  • 75
  • 3
    +1 Along similar lines a non-variant array is a SAFEARRAY struct which also contains various members & a pointer to its data that you could *possibly* copy & overwrite. (the vb runtime varptrarray() export returns a pointer to a vba arrays SAFEARRAY header) – Alex K. May 03 '13 at 10:11
  • 2
    @AlexK. Brilliant! I was not aware of the [Automation array manipulation API](http://msdn.microsoft.com/en-us/library/windows/desktop/ms221145(v=vs.85).aspx). I infer that VB[A] runtime uses this API to implement its arrays, so I suddenly have a clear view into some VB runtime internals, something I'm always looking for. – Joshua Honig May 03 '13 at 12:48
1

What about this solution...

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                   (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub TRIAL()
Dim myValueType As Integer
Dim mySecondValueType As Integer
Dim memPTR As Long

myValueType = 67
memPTR = VarPtr(mySecondValueType)
CopyMemory ByVal memPTR, myValueType, 2
Debug.Print mySecondValueType
End Sub

The concept came from a CodeProject article here

Marshall
  • 99
  • 5
  • That still copies the value, not the reference. If the reference was successfully copied, then setting `mySecondValueType = 42` would also change the value of `myValueType`. – Joshua Honig May 01 '13 at 19:38
1

Although you can use CopyMemory and FillMemory, I'd strongly advise that you never keep these references around for too long. As an example I made stdRefArray class based on this exact principle, DO NOT USE THIS CODE! Read on to find out why...:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "stdRefArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'I STRONGLY RECOMMEND AGAINST USING THIS CLASS. SEE WHY HERE:
'https://stackoverflow.com/a/63838676/6302131

'Status WIP
'High level wrapper around 2d array.

#Const DEBUG_PERF = False

'Variables for pData
Private Declare PtrSafe Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cbCopy As Long)


Public Data As Variant

Private Const VARIANT_SIZE As Long = 16

Public Function Create(ByRef Data As Variant) As stdRefArray
    Set Create = New stdRefArray
    Call Create.Init(Data)
End Function
Public Sub Init(ByRef DataIn As Variant)
    'Create direct reference to array:
    CopyMemory Data, DataIn, VARIANT_SIZE
End Sub

Private Sub Class_Terminate()
   'Clean up array reference
   FillMemory Data, VARIANT_SIZE, 0
End Sub

Public Function GetData(ByVal iRow as long, ByVal iCol as long) as Variant
  Attribute GetData.VB_UserMemID=0
  GetData = GetData(iRow,iCol)
End Function

My initial idea of using this class was to do something like the following:

Cars.FindCar(...).GetDoor(1).Color = Rgb(255,0,0)

where the Car class has a reference to the Cars array, and similarly with the Door class stores a reference to the Cars array, allowing for "instant" setters straight to the source of the initial data.

This works fine! But...

I came across massive issues while debugging. If you're in debug mode, in the Door class, in the color setter, if you make a change to the structure which will need recompilation I.E. Change the name of a dimed variable, change the name of a method/property, or changed their types, Excel will instantly crash. A similar thing will occur when you click the VBA stop (square) button. Not only this, but it is extremely nasty to debug these instant crashes from Excel...

This makes the above code ensure the rest of your code base is also difficult to maintain. It will increase time to make fixes, cause a lot of frustration and make. The time saved in runtime doesn't justify the time it'll take to fix issues around it.

If you do ever make these array references ensure you keep their lives incredibly short, and adequately comment in between regarding debugging issues.

Note: If anyone can find a work around this crash issue (i.e. properly clean up the stack prior to VBA crash, I'd be very interested!)

Instead I highly suggest you use a simple class like this:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "stdRefArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Status WIP
'High level wrapper around arrays
Public Event Changed(ByVal iRow As Long, ByVal iCol As Long, ByVal Value As Variant)
Public vData As Variant

Public Function Create(ByRef Data As Variant) As stdRefArray
    Set Create = New stdRefArray
    Call Create.Init(Data)
End Function
Public Sub Init(ByRef Data As Variant)
    'Slow, but a stable reference
    vData = Data
End Sub



Public Property Get Data(Optional ByVal iRow As Long = -1, Optional ByVal iCol As Long = -1) As Variant
Attribute Data.VB_UserMemId = 0
    If iRow = -1 And iCol = -1 Then
        CopyVariant Data, vData
    ElseIf iRow <> -1 And iCol <> -1 Then
        CopyVariant Data, vData(iRow, iCol)
    Else
        stdError.Raise "stdRefArray::Data() - Invalid use of Data", vbCritical
    End If
End Property
Public Property Let Data(ByVal iRow As Long, ByVal iCol As Long, Value As Variant)
    vData(iRow, iCol) = Value
    RaiseEvent Changed(iRow, iCol, Value)
End Property
Public Property Set Data(ByVal iRow As Long, ByVal iCol As Long, Value As Object)
    Set vData(iRow, iCol) = Value
    RaiseEvent Changed(iRow, iCol, Value)
End Property
Public Property Get BoundLower(ByVal iDimension As Long) As Long
    BoundLower = LBound(vData, iDimension)
End Property
Public Property Get BoundUpper(ByVal iDimension As Long) As Long
    BoundUpper = UBound(vData, iDimension)
End Property


Private Function CopyVariant(ByRef dest As Variant, ByVal src As Variant)
    If IsObject(src) Then
        Set dest = src
    Else
        dest = src
    End If
End Function

I've added a few extra steps which will help with bindings. You do still very much lose a lot of native behaviour, however this is the safest bet which is also the easiest to maintain. It will also be the fastest way to get collection-like functionality without using a collection.

Usage, Car.cls:

Private WithEvents pInventory as stdRefArray
Public Function Create(ByRef arrInventory as variant)
   Set Create = new Car
   Set Create.pInventory = stdRefArray.Create(arrInventory)
End Function
Public Function GetDoor(ByVal iRow as long) as Door
   Set GetDoor = new Door
   GetDoor.init(pInventory,iRow)
End Function

Door.cls

Private pArray as stdRefArray
Private pRow as long
Private Const iColorColumn = 10
Sub Init(ByVal array as stdRefArray, ByVal iRow as long)
    set pArray = array
    pRow = iRow
End Sub
Public Property Get Color() as long
    Color = pArray(pRow,iColorColumn)
End Property
Public Property Let Color(ByVal iNewColor as long)
    pArray(pRow,iColorColumn) = iNewColor
End Property

The example probably isn't too great lol, but hopefully you get the idea.

Sancarn
  • 2,575
  • 20
  • 45
1

You could use the method called GetArrayByRef from my repository VBA-MemoryTools. However, if you don't want the extra reference you could use this limited, slower code:

Option Explicit

#If Mac Then
    #If VBA7 Then
        Public Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr
    #Else
        Public Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long
    #End If
#Else 'Windows
    'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx
    #If VBA7 Then
        Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #Else
        Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    #End If
#End If

Public Const VT_BYREF As Long = &H4000
#If Win64 Then
    Public Const PTR_SIZE As Long = 8
#Else
    Public Const PTR_SIZE As Long = 4
#End If

Public Function GetArrayByRef(ByRef arr As Variant) As Variant
    If IsArray(arr) Then
        GetArrayByRef = VarPtrArr(arr)
        Dim vt As VbVarType: vt = VarType(arr) Or VT_BYREF
        CopyMemory GetArrayByRef, vt, 2
    Else
        Err.Raise 5, "GetArrayByRef", "Array required"
    End If
End Function

#If Win64 Then
Public Function VarPtrArr(ByRef arr As Variant) As LongLong
#Else
Public Function VarPtrArr(ByRef arr As Variant) As Long
#End If
    Const vtArrByRef As Long = vbArray + VT_BYREF
    Dim vt As VbVarType
    CopyMemory vt, arr, 2
    If (vt And vtArrByRef) = vtArrByRef Then
        Const pArrayOffset As Long = 8
        CopyMemory VarPtrArr, ByVal VarPtr(arr) + pArrayOffset, PTR_SIZE
    Else
        Err.Raise 5, "VarPtrArr", "Array required"
    End If
End Function

Quick test:

Sub Demo()
    Dim arr() As String
    ReDim arr(1 To 2)
    arr(1) = "AAA"
    
    Dim v As Variant
    
    v = GetArrayByRef(arr)
    v(2) = "BBB"
    
    Debug.Assert arr(2) = "BBB"
End Sub

It's also safe - you don't have to worry about memory deallocation

Cristian Buse
  • 4,020
  • 1
  • 13
  • 34