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 dim
ed 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.