5
\$\begingroup\$

Some utility functions I re-wrote today:

Purpose:

  • Given an arbitrary list of 1-D arrays (possibly empty variables), return a 1-D array containing unique values from all lists.
  • Ex: Given (1,2,3) (1,2,4), (4,7,9) and Empty, return (1,2,3,4,7,9)
  • The returned list will not necessarily be sorted

Notes on debugging:

The target environment for this code is non-critical macros running on either my computer or computers within about 20 feet of my desk. So:

Debug.Print "message"
Stop

Is my preferred way of dealing with unexpected errors for the time being.


Desired Feedback:

Particularly looking for feedback on readability, understandability, and documentation.


MergeLists()

Public Function MergeLists(ParamArray inputLists()) As Variant
    '/ Given an arbitrary list of 1-D arrays (possibly empty variables), return a 1-D array containing unique values from all lists.
    '/ Ex: Given (1,2,3) (1,2,4), (4,7,9) and Empty, return (1,2,3,4,7,9)
    '/ The returned list will not necessarily be sorted

    Dim LB1 As Long, UB1 As Long
    LB1 = LBound(inputLists)
    UB1 = UBound(inputLists)

    '/ Validate inputs as either 1-D arrays, or empty
    Dim isValidArgument As Boolean
    isValidArgument = True
    Dim ix As Long
    For ix = LB1 To UB1
        If Not IsValidArray(inputLists(ix), 1, allowEmpty:=True) Then
            Debug.Print "Invalid argument. ix = " & ix
            isValidArgument = False
        End If
    Next ix

    If Not isValidArgument Then
        Debug.Print "one or more arguments are invalid"
        Stop
    End If

    '/ For each list, add values as key-values to a central dictionary
    Dim valuesDict As Dictionary
    Set valuesDict = New Dictionary
    Dim iy As Long
    For ix = LB1 To UB1
        Dim currentArray As Variant
        currentArray = inputLists(ix)
        If Not IsEmpty(currentArray) Then
            For iy = LBound(currentArray) To UBound(currentArray)
                valuesDict.item(currentArray(iy)) = currentArray(iy)
            Next iy
        End If
    Next ix

    '/ Read out all key-values (already unique) to a new array
    Dim mergedArray As Variant
    ReDim mergedArray(1 To 1)
    Dim valueCounter As Long
    valueCounter = 0
    Dim key As Variant
    For Each key In valuesDict.Keys()
        valueCounter = valueCounter + 1
        ReDim Preserve mergedArray(1 To valueCounter)
        mergedArray(valueCounter) = valuesDict.item(key)
    Next key

    MergeLists = mergedArray

End Function

IsValidArray()

Public Function IsValidArray(ByRef targetArray As Variant, ByVal validNumberOfDimensions As Long, Optional ByVal allowEmpty As Boolean) As Boolean
    '/ Check whether the target is an allocated array with the specified number of dimensions

    If allowEmpty And IsEmpty(targetArray) Then
        IsValidArray = True
    Else
        IsValidArray = (IsAllocated(targetArray) And (DimensionCountOfArray(targetArray) = validNumberOfDimensions))
    End If

End Function

IsAllocated()

Public Function IsAllocated(ByRef varArray As Variant) As Boolean
    '/ Given a Variant:
    '/ Check that it is an array
    '/ Check that it has assigned Bounds in at least the first dimension

    On Error GoTo CleanFail:
    IsAllocated = IsArray(varArray) And Not IsError(LBound(varArray, 1)) And LBound(varArray, 1) <= UBound(varArray, 1)
    On Error GoTo 0

CleanExit:
    Exit Function

CleanFail:
    On Error GoTo 0
    IsAllocated = False
    Resume CleanExit

End Function

DimensionCountOfArray()

Public Function DimensionCountOfArray(ByRef targetArray As Variant)
    '/ First check that the Variable is, in fact, an allocated array
    '/ If it is, iteratively attempt to access dimensions until an error is encountered, then return the last dimension successfully accessed
    '/ If it is not an allocated array, return 0

    Dim maxDimension As Long
    maxDimension = 0

    If Not IsAllocated(targetArray) Then
        '/ Not a valid target, return 0
        GoTo maxFound
    Else
        '/ Is a valid target, check dimensions
        Dim errCheck As Variant
        Do While maxDimension <= 100000 '/ Arbitrary Magic Number
            On Error GoTo maxFound
                errCheck = LBound(targetArray, maxDimension + 1)
            On Error GoTo 0
            maxDimension = maxDimension + 1
        Loop
    End If

maxFound:
    On Error GoTo 0
    DimensionCountOfArray = maxDimension

End Function
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

Dim valuesDict As Dictionary

You don't use extra functionality of Dictionary, why not use a Collection?

If allowEmpty And IsEmpty(targetArray) Then

This will fail if allowEmpty is Missing

\$\endgroup\$
1
  • 1
    \$\begingroup\$ Habit I guess. I can't remember the last time I needed to use a collection. \$\endgroup\$
    – Kaz
    May 28, 2017 at 15:07

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.