A good substitute for references/pointers in VBA?
Asked Answered
T

5

9

Can you recommend me a good substitute for reference or pointer types in VBA? I have been struggling for long with expressions like this:

dblMyArray( i * lngDimension0 + j * lngDimension1 + k * lngDimension2, l * lngDimension3 + m * lngDimension4 ) = dblMyArray( i * lngDimension0 + j * lngDimension1 + k * lngDimension2, l * lngDimension3 + m * lngDimension4 ) + 1

If I wanted to accumulate values in a multidimensional array in e.g. C++, I could write this:

double& rElement = dblMyArray[ i * lngDimension0 + j * lngDimension1 + k * lngDimension2 ][ l * lngDimension3 + m * lngDimension4 ];
rElement += 1;

or

double* pElement = &dblMyArray[ i * lngDimension0 + j * lngDimension1 + k * lngDimension2 ][ l * lngDimension3 + m * lngDimension4 ];
*pElement += 1;

I am looking for something like this.

I don't want to repeat the element on the right side of the assignment and I don't want to call a function with ByRef arguments because that would make the maintenance of the code much more difficult.

Any ideas?

Typewritten answered 25/8, 2016 at 11:26 Comment(9)
Why would you want to use pointer-like behaviour in VBA in the first place? Are there any advantages at all?Pyromania
Since VBA supports multidimensional arrays directly, why do you want to emulate them with pointers?Coletta
stackoverflow.com/documentation/vba/3064/arrays/17455/…Supplication
Of course it has an advantage: without references or pointers, the syntax is very clumsy (If you look at my example codes, the scroll bar width is about the half in case of VBA).Typewritten
I know that that there are multidimensional arrays in VBA, my example code uses them, too (note the ','). It is two dimensional because it will be assigned to the Value of a Range, however, the data it contains has more dimensions. This is very common if you have to arrange complex data into human-readable cross-tables. And I would like the pointer or reference syntax to have easier-to-understand code.Typewritten
Then the answer is: No, there isn't.Endearment
VBA is a somewhat verbose programming language, and it does lack pointers. If you do this sort of thing a lot and it bothers you, you can abstract the array iteration to a sub, something like (Increment(A,i) which adds i to each element of array A). It will need to be a ByRef sub, but ByRef is the default in VBA. If the array parameter in Increment is declared to be type Variant (which is as close as VBA gets to a pointer) there shouldn't be much problem.Coletta
If you enclose your variable in a class and you tweak the Class manually, you could have a class that mimic the behavior of a base type and you should be able to Set a reference to it.Lavation
I think VBA was made more for non-programmers or not experienced programmers, so giving them access to pointers does not seem like a good idea. I also think that pointers can cause more harm than help even if you are confident that you know how to use them.Supplication
G
15

VBA supports pointers, but only to a very limited extent and mostly for use with API functions that require them (via VarPtr, StrPtr, and ObjPtr). You can do a little bit of hackery to get the base address of an array's memory area. VBA implements arrays as SAFEARRAY structures, so the first tricky part is getting the memory address of the data area. The only way I've found to do this is by letting the runtime box the array in a VARIANT and then pulling it apart:

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

Private Const VT_BY_REF = &H4000&

Public Function GetBaseAddress(vb_array As Variant) As Long
    Dim vtype As Integer
    'First 2 bytes are the VARENUM.
    CopyMemory vtype, vb_array, 2
    Dim lp As Long
    'Get the data pointer.
    CopyMemory lp, ByVal VarPtr(vb_array) + 8, 4
    'Make sure the VARENUM is a pointer.
    If (vtype And VT_BY_REF) <> 0 Then
        'Dereference it for the variant data address.
        CopyMemory lp, ByVal lp, 4
        'Read the SAFEARRAY data pointer.
        Dim address As Long
        CopyMemory address, ByVal lp, 16
        GetBaseAddress = address
    End If
End Function

The second tricky part is that VBA doesn't have a native method to dereference pointers, so you'll need another helper function to do that:

Public Function DerefDouble(pData As Long) As Double
    Dim retVal As Double
    CopyMemory retVal, ByVal pData, LenB(retVal)
    DerefDouble = retVal
End Function

Then you can use the pointer just like you would in C:

Private Sub Wheeeeee()
    Dim foo(3) As Double
    foo(0) = 1.1
    foo(1) = 2.2
    foo(2) = 3.3
    foo(3) = 4.4

    Dim pArray As Long
    pArray = GetBaseAddress(foo)
    Debug.Print DerefDouble(pArray) 'Element 0
    Debug.Print DerefDouble(pArray + 16) 'Element 2
End Sub

Whether or not this is a good idea or is better than what you're doing now is left as an exercise for the reader.

Griego answered 25/8, 2016 at 13:10 Comment(1)
Impressive hackery. +1 (though -- I don't think that actually using this would be a very good idea.)Coletta
C
6

You could do something like this:

Sub ArrayMap(f As String, A As Variant)
    'applies function with name f to
    'every element in the 2-dimensional array A

    Dim i As Long, j As Long
    For i = LBound(A, 1) To UBound(A, 1)
        For j = LBound(A, 2) To UBound(A, 2)
            A(i, j) = Application.Run(f, A(i, j))
        Next j
    Next i
End Sub

For example:

If you define:

Function Increment(x As Variant) As Variant
    Increment = x + 1
End Function

Function TimesTwo(x As Variant) As Variant
    TimesTwo = 2 * x
End Function

Then the following code applies these two functions to two arrays:

Sub test()
    Dim Vals As Variant

    Vals = Range("A1:C3").Value
    ArrayMap "Increment", Vals
    Range("A1:C3").Value = Vals

    Vals = Range("D1:F3").Value
    ArrayMap "TimesTwo", Vals
    Range("D1:F3").Value = Vals

End Sub

On Edit: Here is a more involved version that allows optional parameters to be passed. I took it out to 2 optional parameters, but it is easily extended to more:

Sub ArrayMap(f As String, A As Variant, ParamArray args() As Variant)
    'applies function with name f to
    'every element in the 2-dimensional array A
    'up to two additional arguments to f can be passed

    Dim i As Long, j As Long
    Select Case UBound(args)
        Case -1:
            For i = LBound(A, 1) To UBound(A, 1)
                For j = LBound(A, 2) To UBound(A, 2)
                    A(i, j) = Application.Run(f, A(i, j))
                Next j
            Next i
        Case 0:
            For i = LBound(A, 1) To UBound(A, 1)
                For j = LBound(A, 2) To UBound(A, 2)
                    A(i, j) = Application.Run(f, A(i, j), args(0))
                Next j
            Next i
        Case 1:
            For i = LBound(A, 1) To UBound(A, 1)
                For j = LBound(A, 2) To UBound(A, 2)
                    A(i, j) = Application.Run(f, A(i, j), args(0), args(1))
                Next j
            Next i
     End Select
End Sub

Then if you define something like:

Function Add(x As Variant, y As Variant) As Variant
    Add = x + y
End Function

the call ArrayMap "Add", Vals, 2 will add 2 to everything in the array.

On Further Edit: Variation on a theme. Should be self explanatory:

Sub ArrayMap(A As Variant, f As Variant, Optional arg As Variant)
    'applies operation or function with name f to
    'every element in the 2-dimensional array A
    'if f is "+", "-", "*", "/", or "^", arg is the second argument and is required
    'if f is a function, the second argument is passed if present

    Dim i As Long, j As Long
    For i = LBound(A, 1) To UBound(A, 1)
        For j = LBound(A, 2) To UBound(A, 2)
            Select Case f:
            Case "+":
                A(i, j) = A(i, j) + arg
            Case "-":
                A(i, j) = A(i, j) - arg
            Case "*":
                A(i, j) = A(i, j) * arg
            Case "/":
                A(i, j) = A(i, j) / arg
            Case "^":
                A(i, j) = A(i, j) ^ arg
            Case Else:
                If IsMissing(arg) Then
                    A(i, j) = Application.Run(f, A(i, j))
                Else
                    A(i, j) = Application.Run(f, A(i, j), arg)
                End If
            End Select
        Next j
    Next i
End Sub

Then, for example, ArrayMap A, "+", 1 will add 1 to everything in the array.

Coletta answered 25/8, 2016 at 12:44 Comment(1)
Now we're cookin' with a VBA analogue of function pointers. +1Griego
D
3

To add to these answers, I've found a really nice (I think) way to DeReference pointers:

Option Explicit

Private Enum BOOL
    API_FALSE = 0
    'Use NOT (result = API_FALSE) for API_TRUE, as TRUE is just non-zero
End Enum

Private Enum VirtualProtectFlags 'See Memory Protection constants: https://learn.microsoft.com/en-gb/windows/win32/memory/memory-protection-constants
    PAGE_EXECUTE_READWRITE = &H40
End Enum

#If Win64 Then 'To decide whether to use 8 or 4 bytes per chunk of memory
    Private Declare Function GetMem Lib "msvbvm60" Alias "GetMem8" (ByRef src As Any, ByRef dest As Any) As Long
#Else
    Private Declare Function GetMem Lib "msvbvm60" Alias "GetMem4" (ByRef src As Any, ByRef dest As Any) As Long
#End If

#If VBA7 Then 'for LongPtr
    Private Declare Function VirtualProtect Lib "kernel32" (ByRef location As Any, ByVal numberOfBytes As Long, ByVal newProtectionFlags As VirtualProtectFlags, ByVal lpOldProtectionFlags As LongPtr) As BOOL
#Else
    Private Declare Function VirtualProtect Lib "kernel32" (ByRef location As Any, ByVal numberOfBytes As Long, ByVal newProtectionFlags As VirtualProtectFlags, ByVal lpOldProtectionFlags As LongPtr) As BOOL
#End If

#If VBA7 Then
    Public Property Let DeRef(ByVal address As LongPtr, ByVal value As LongPtr)
        'unprotect memory for writing
        Dim oldProtectVal As VirtualProtectFlags
        If VirtualProtect(ByVal address, LenB(value), PAGE_EXECUTE_READWRITE, VarPtr(oldProtectVal)) = API_FALSE Then
            Err.Raise 5, Description:="That address is protected memory which cannot be accessed"                
        Else
            GetMem value, ByVal address
        End If
    End Property

    Public Property Get DeRef(ByVal address As LongPtr) As LongPtr
        GetMem ByVal address, DeRef
    End Property

#Else
    Public Property Let DeRef(ByVal address As Long, ByVal value As Long)
        'unprotect memory for writing
        Dim oldProtectVal As VirtualProtectFlags
        If VirtualProtect(ByVal address, LenB(value), PAGE_EXECUTE_READWRITE, VarPtr(oldProtectVal)) = API_FALSE Then
            Err.Raise 5, Description:="That address is protected memory which cannot be accessed"
        Else
            GetMem value, ByVal address
        End If
    End Property

    Public Property Get DeRef(ByVal address As Long) As Long
        GetMem ByVal address, DeRef
    End Property

#End If

I'm finding these are absolutely lovely to use and make working with pointers much more straightforward. Here's a simple example:

Public Sub test()
    Dim a As Long, b As Long
    a = 5
    b = 6

    Dim a_address As LongPtr
    a_address = VarPtr(a)

    Dim b_address As LongPtr
    b_address = VarPtr(b)

    DeRef(a_address) = DeRef(b_address) 'the value at &a = the value at &b

    Debug.Assert a = b 'succeeds

End Sub
Dronski answered 3/11, 2019 at 19:33 Comment(0)
L
1

You can use a sub with reference parameters:

Sub Add2Var(ByRef variable As Double, ByVal value As Double)
    variable = variable + value
End Sub

used like this:

Sub Test()
    Dim da(1 To 2) As Double
    Dim i As Long
    For i = 1 To 2
        da(i) = i * 1.1
    Next i
    Debug.print da(1), da(2)
    Add2Var da(1), 10.1
    Add2Var da(2), 22.1
    Debug.print da(1), da(2)
End Sub
Lavation answered 25/8, 2016 at 11:42 Comment(1)
Thanks, Vincent G, but I would like it without function call. The operation is not always addition and I don't like jumping to one line long functions in the editor or the debugger.Typewritten
S
1

Unfortunately += is not supported in VBA, but here are few alternatives ( I shortened the lngDimension to d ) :

x = i * d0 + j * d1 + k * d2
y = l * d3 + m * d4 

dblMyArray(x,y) = dblMyArray(x,y) + 1

or 5 dimensions

Dim dblMyArray(d0, d1, d2, d3, d4) As Double

dblMyArray(i,j,k,l,m) = dblMyArray(i,j,k,l,m) + 1

or this 1 dimension monster (that I probably got wrong)

Dim dblMyArray(d0 * d1 * d2 * d3 * d4) As Double ' only one dimension

For i = 0 to d0 * d1 * d2 * d3 * d4 Step d1 * d2 * d3 * d4
     For j = i to d1 * d2 * d3 * d4 Step d2 * d3 * d4
          For k = j to d2 * d3 * d4 Step d3 * d4
               For l = k to d3 * d4 Step d4
                    For m = l to d4 Step 1
                          dblMyArray(m) = dblMyArray(m) + 1
                    Next m
               Next l
          Next k
     Next j
Next i

or maybe jagged arrays

Dim MyArray , subArray ' As Variant 
MyArray = Array( Array( 1, 2, 3 ), Array( 4, 5, 6 ), Array( 7, 8, 9 ) ) 

' access like MyArray(x)(y) instead of MyArray(x, y)

For Each subArray In MyArray
    For Each item In subArray 
         item = item + 1 ' not sure if it works this way instead of subArray(i)
    Next        
Next
Supplication answered 25/8, 2016 at 21:12 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.