Copy an array reference in VBA Copy an array reference in VBA vba vba

Copy an array reference in VBA


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 crashEnd 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


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 IntegerDim mySecondValueType As IntegerDim memPTR As LongmyValueType = 67memPTR = VarPtr(mySecondValueType)CopyMemory ByVal memPTR, myValueType, 2Debug.Print mySecondValueTypeEnd Sub

The concept came from a CodeProject article here


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 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = "stdRefArray"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute 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 pDataPrivate 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 VariantPrivate Const VARIANT_SIZE As Long = 16Public Function Create(ByRef Data As Variant) As stdRefArray    Set Create = New stdRefArray    Call Create.Init(Data)End FunctionPublic Sub Init(ByRef DataIn As Variant)    'Create direct reference to array:    CopyMemory Data, DataIn, VARIANT_SIZEEnd SubPrivate Sub Class_Terminate()   'Clean up array reference   FillMemory Data, VARIANT_SIZE, 0End SubPublic 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 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = "stdRefArray"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False'Status WIP'High level wrapper around arraysPublic Event Changed(ByVal iRow As Long, ByVal iCol As Long, ByVal Value As Variant)Public vData As VariantPublic Function Create(ByRef Data As Variant) As stdRefArray    Set Create = New stdRefArray    Call Create.Init(Data)End FunctionPublic Sub Init(ByRef Data As Variant)    'Slow, but a stable reference    vData = DataEnd SubPublic Property Get Data(Optional ByVal iRow As Long = -1, Optional ByVal iCol As Long = -1) As VariantAttribute 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 IfEnd PropertyPublic Property Let Data(ByVal iRow As Long, ByVal iCol As Long, Value As Variant)    vData(iRow, iCol) = Value    RaiseEvent Changed(iRow, iCol, Value)End PropertyPublic 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 PropertyPublic Property Get BoundLower(ByVal iDimension As Long) As Long    BoundLower = LBound(vData, iDimension)End PropertyPublic Property Get BoundUpper(ByVal iDimension As Long) As Long    BoundUpper = UBound(vData, iDimension)End PropertyPrivate Function CopyVariant(ByRef dest As Variant, ByVal src As Variant)    If IsObject(src) Then        Set dest = src    Else        dest = src    End IfEnd 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 stdRefArrayPublic Function Create(ByRef arrInventory as variant)   Set Create = new Car   Set Create.pInventory = stdRefArray.Create(arrInventory)End FunctionPublic Function GetDoor(ByVal iRow as long) as Door   Set GetDoor = new Door   GetDoor.init(pInventory,iRow)End Function

Door.cls

Private pArray as stdRefArrayPrivate pRow as longPrivate Const iColorColumn = 10Sub Init(ByVal array as stdRefArray, ByVal iRow as long)    set pArray = array    pRow = iRowEnd SubPublic Property Get Color() as long    Color = pArray(pRow,iColorColumn)End PropertyPublic Property Let Color(ByVal iNewColor as long)    pArray(pRow,iColorColumn) = iNewColorEnd Property

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