Search code examples
arraysexcelvbanotation

Passing Values "directly" to an array in VBA


It's possible to assign "whole" arrays "directly" to an Variant variable in VBA (usually used for reading/writing whole ranges e.g. varRange = Range("A1:A3").Value):

Dim varVariable As Variant
varVariant = Array("a", "b", "c")

Dim arrVariant() As Variant
arrVariantVarSize = Array("d", "e", "f")

Is it possible to do that with an array consisting of a regular data type (not necessarily just string or integer)? Similar to this (which does not work since array() returns a variant array that can't be assigned to a string or integer array):

Dim arrString(2) As String
arrString = Array("a", "b", "c")  '-> throws an exception

Dim arrInteger (2) As Integer
arrInteger = Array(1, 2, 3)  '-> throws an exception

Instead of this:

Dim arrString(2) As String
arrString(0) = Array("a")
arrString(1) = Array("b")
arrString(2) = Array("c")

Dim arrInteger(2) As String
arrInteger(0) = Array(1)
arrInteger(1) = Array(2)
arrInteger(2) = Array(3)

Solution

  • Return Variant Array Values in a String Array

    • No matter what the motives are for doing this (performance issues, keeping it explicit, doing it in one line of code, etc.), you could use the StrArray function.
    Option Explicit
    'Option Base 1 ' try and see that 'sArr' will always be zero-based
    ' To ensure that 'vArr' is zero-based, use 'vArr = VBA.Array("a", "b", "c")'.
    
    Sub StrArrayTEST()
        
        ' Note that the 'vArr' parentheses are necessary to prevent
        ' 'Compile error: Type mismatch: array or user-defined type expected'...
        Dim vArr() As Variant: vArr = Array("a", "b", "c") ' try 'vArr = Array()'
        ' ... in the following 'sArr=...' line, where 'vArr' is highlighted.
        Dim sArr() As String: sArr = StrArray(vArr)
        
        ' The following line instead, doesn't compile with the same error
        ' (because of 'ByRef' in the function?) with 'Array' highlighted.
        'Dim sArr() As String: sArr = StrArray(Array("a", "b", "c"))
        
        Debug.Print "String Array Values"
        Debug.Print "Index", "String"
        
        Dim n As Long
        For n = 0 To UBound(sArr)
            Debug.Print n, sArr(n)
        Next n
        
        Debug.Print "Array   LB/UB       Vartype TypeName"
        Debug.Print "Variant [LB=" & LBound(vArr) & ",UB=" & UBound(vArr) & "]" _
            & " VT=" & VarType(vArr) & " TN=" & TypeName(vArr)
        Debug.Print "String  [LB=" & LBound(sArr) & ",UB=" & UBound(sArr) & "]" _
            & " VT=" & VarType(sArr) & " TN=" & TypeName(sArr)
        
    End Sub
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Purpose:      Returns the values from a variant array ('VariantArray'),
    '               converted to strings, in a zero-based string array.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Function StrArray( _
        VariantArray() As Variant) _
    As String() ' 'ByVal VariantArray() As Variant' is not possible
        Const ProcName As String = "StrArray"
        Dim AnErrorOccurred As Boolean
        On Error GoTo ClearError ' turn on error-trapping
        
        Dim LB As Long: LB = LBound(VariantArray)
        Dim UB As Long: UB = UBound(VariantArray)
        
        Dim StringArray() As String: ReDim StringArray(0 To UB - LB)
        
        Dim n As Long
        
        For n = LB To UB
            StringArray(n - LB) = CStr(VariantArray(n))
        Next n
        
    ProcExit:
        On Error Resume Next ' defer error-trapping (to prevent endless loop)
            If AnErrorOccurred Then
                ' Ensure the result is a string array.
                StrArray = Split("") ' LB = 0, UB = -1
            Else
                StrArray = StringArray
            End If
        On Error GoTo 0 ' turn off error-trapping (before exiting)
        
        Exit Function
    ClearError:
        Debug.Print "'" & ProcName & "' Run-time error '" _
            & Err.Number & "':" & vbLf & "    " & Err.Description
        AnErrorOccurred = True
        Resume ProcExit ' continue error-trapping
    End Function