9
\$\begingroup\$

As I said in my last post Multi-dimensional ascending and descending sort array function, I'm back with the final version of the code.

Added features:

  1. Filter array function by following parameters: GraterThan, LessThan, Equals, NotEquals, Contains, DoesNotContain, ContainRegex, DoesNotContainRegex, BeginsWith, EndsWith, and the list could be completed as needed based on the same logic.
  2. Necessary regex functions (adapted from code found on the Internet and requires Microsoft VBScript Regular Expressions 5.5 library).
  3. All array functions are extended to 31 dimensions.
  4. Existing intermediary functions are versatile; it could be used for various array operations.
  5. The code works fast even with large amounts of data.

The code does not contain any error handling, because, depending on usage purposes, it can be designed in various shapes.

Option Explicit

Public Function SortArray(ByRef arr As Variant, _
                          ByVal selPoint As Variant, _
                          ByRef selDim As Integer, _
                 Optional ByRef ascend As Boolean = True) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Multi Dimensional Ascending and Descending Sort Array Function
'Inputs:
'1) arr         = one to 31 dimensional symmetrical array
'2) selPoint    = selected point index as string e.g. "arr(1,15,4)" or just "(1,15,4)"
'3) selDim      = selected dimension, integer from 1 to 31
'4) ascend      = Optional ascending or descending direction (default = ascending)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim seq As Variant, seqArr As Variant, idx As Variant, s As Variant, d As Variant
Dim i As Integer, arrDim As Integer
Dim LB As Long, UB As Long

    LB = LBound(arr, selDim)
    UB = UBound(arr, selDim)
    ReDim seqArr(UB)
    ' counting input array dimensions
    On Error Resume Next
    Do
        arrDim = arrDim + 1
        seq = UBound(arr, arrDim)
    Loop Until Err.Number <> 0
        arrDim = arrDim - 1
    On Error GoTo 0
    ' preparing a surrogate sequence array
    ReDim seq(UB)
    'For i = LB To UB
    'seq(i) = i
    'Next i
    'replaced with multifunctional ArrayAction function
    seq = ArrayAction(seq, , "fillSeries")
    ' taking the address references from selPoint
    '(sort operation requires a point and a sort direction to determine sort axis)
    s = Split(Split(selPoint, "(")(1), ")")(0)
    s = Split(s, ",")
    ' fill the address references into another array
    ReDim d(arrDim - 1)
    'For i = 0 To arrDim - 1
    'd(i) = s(i)
    'Next i
    'replaced with
    d = ArrayAction(d, , "fillSequence", s)
    ' in order to make the sort operation extract the sort axis values into another surrogate sequence array
    For i = LB To UB

        d(selDim - 1) = i
        Select Case arrDim
            Case Is = 1:        seqArr(i) = arr(d(0))
            Case Is = 2:        seqArr(i) = arr(d(0), d(1))
            Case Is = 3:        seqArr(i) = arr(d(0), d(1), d(2))
            Case Is = 4:        seqArr(i) = arr(d(0), d(1), d(2), d(3))
            Case Is = 5:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4))
            Case Is = 6:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5))
            Case Is = 7:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6))
            Case Is = 8:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7))
            Case Is = 9:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8))
            Case Is = 10:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9))
            Case Is = 11:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10))
            Case Is = 12:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11))
            Case Is = 13:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12))
            Case Is = 14:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13))
            Case Is = 15:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14))
            Case Is = 16:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15))
            Case Is = 17:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16))
            Case Is = 18:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17))
            Case Is = 19:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18))
            Case Is = 20:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19))
            Case Is = 21:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20))
            Case Is = 22:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21))
            Case Is = 23:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22))
            Case Is = 24:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23))
            Case Is = 25:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24))
            Case Is = 26:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25))
            Case Is = 27:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26))
            Case Is = 28:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27))
            Case Is = 29:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28))
            Case Is = 30:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29))
            Case Is = 31:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29), d(30))
        End Select

    Next i
    ' preparing an empty intex array
    idx = ArrayAction(arr, , "clearArray")
    ' sorting extracted array axis and put the results into prepared surrogate array
    seq = SortSeq(seqArr, seq, LB, UB, ascend)
    ' filling prepared index array with reordered indexes
    idx = ArrayAction(arr, idx, "sortIndex", seq, selDim)
    ' using reordered indexes to repopulate input array
    SortArray = ArrayAction(arr, idx, "sortArray")

End Function

Public Function FilterArray(ByRef arr As Variant, _
                            ByVal selPoint As Variant, _
                            ByRef selDim As Integer, _
                            ByRef operator As String, _
                   Optional ByRef operand As String = "*") As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Multi Dimensional Ascending and Descending Filter Array Function
'Inputs:
'1) arr         = one to 31 dimensional symmetrical array
'2) selPoint    = selected point index as string e.g. "arr(1,15,4)" or just "(1,15,4)"
'3) selDim      = selected dimension, integer from 1 to 31
'4) operator    = filter operator as string: "GraterThan","LessTan"... (option list available at FilterSeq function)
'5) operand     = Optional filter term (default = "*")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim seq As Variant, seqArr As Variant, idx As Variant, s As Variant, d As Variant
Dim i As Integer, arrDim As Integer
Dim LB As Long, UB As Long

    LB = LBound(arr, selDim)
    UB = UBound(arr, selDim)
    ReDim seqArr(UB)
    ' counting input array dimensions
    On Error Resume Next
    Do
        arrDim = arrDim + 1
        seq = UBound(arr, arrDim)
    Loop Until Err.Number <> 0
        arrDim = arrDim - 1
    On Error GoTo 0
    ' preparing a surrogate sequence array
    ReDim seq(UB)
    seq = ArrayAction(seq, , "fillSeries")
    ' taking the address references from selPoint
    '(sort operation requires a point and a sort direction to determine sort axis)
    s = Split(Split(selPoint, "(")(1), ")")(0)
    s = Split(s, ",")
    ' fill the address references into another array
    ReDim d(arrDim - 1)
    d = ArrayAction(d, , "fillSequence", s)
    ' in order to make the filter operation extract the filter axis values into another surrogate sequence array
    For i = LB To UB

        d(selDim - 1) = i
        Select Case arrDim
            Case Is = 1:        seqArr(i) = arr(d(0))
            Case Is = 2:        seqArr(i) = arr(d(0), d(1))
            Case Is = 3:        seqArr(i) = arr(d(0), d(1), d(2))
            Case Is = 4:        seqArr(i) = arr(d(0), d(1), d(2), d(3))
            Case Is = 5:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4))
            Case Is = 6:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5))
            Case Is = 7:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6))
            Case Is = 8:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7))
            Case Is = 9:        seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8))
            Case Is = 10:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9))
            Case Is = 11:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10))
            Case Is = 12:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11))
            Case Is = 13:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12))
            Case Is = 14:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13))
            Case Is = 15:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14))
            Case Is = 16:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15))
            Case Is = 17:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16))
            Case Is = 18:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17))
            Case Is = 19:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18))
            Case Is = 20:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19))
            Case Is = 21:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20))
            Case Is = 22:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21))
            Case Is = 23:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22))
            Case Is = 24:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23))
            Case Is = 25:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24))
            Case Is = 26:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25))
            Case Is = 27:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26))
            Case Is = 28:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27))
            Case Is = 29:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28))
            Case Is = 30:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29))
            Case Is = 31:       seqArr(i) = arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29), d(30))
        End Select

    Next i
    ' reading surrogate sequence length
    i = UBound(seq)
    ' filtering desired axis using input paramenters
    seq = FilterSeq(seqArr, seq, LB, UB, operator, operand)
    ' if none of filter operands doesn't corespond to any value existing on the reguired axis then result will be an empty array
    If UBound(seq) = i Then
        FilterArray = Empty
        Exit Function
    End If
    ' redimensioning result array's new index to corespond to the filtered dimension
    s(selDim - 1) = UBound(seq)

    d = ArrayAction(d, , "fillSequence", s)

    Call RedimArray(idx, d)
    ' fill the redimensioned index array with address references of the result
    idx = ArrayAction(arr, idx, "filterIndex", seq, selDim)
    ' fill the result array with the values coresponding to indexes
    FilterArray = ArrayAction(arr, idx, "filterArray")

End Function

Private Function ArrayAction(ByVal arr As Variant, _
                    Optional ByRef idx As Variant, _
                    Optional ByRef ActionTag As String = "index", _
                    Optional ByRef seq As Variant, _
                    Optional ByRef sortDim As Integer = 1, _
                    Optional ByRef del As String = ",") As Variant

Dim s As Variant, d As Variant, rArr As Variant, wArr As Variant, oArr As Variant
Dim i As Integer, arrDim As Integer, selDim As Integer

oArr = arr
' counting input array dimensions
On Error Resume Next
Do
    arrDim = arrDim + 1
    d = UBound(arr, arrDim)
Loop Until Err.Number <> 0
    arrDim = arrDim - 1
On Error GoTo 0
' preparing a surrogate array
ReDim d(arrDim - 1)
For i = 0 To arrDim - 1
d(i) = 0
Next i
' redimensioning array's size for filter functions
If ActionTag = "filterIndex" Or ActionTag = "filterArray" Then
    arr = idx
End If
' recursive parsing input array's for read, write amd index build operations starting with right most dimension
For selDim = arrDim To 1 Step -1
    ' array parser
    If selDim <> arrDim Then

        If d(selDim - 1) = UBound(arr, selDim) Then
            On Error Resume Next
            Do
            d(selDim - 1) = LBound(arr, selDim)
            selDim = selDim - 1
            Loop Until d(selDim - 1) <> UBound(arr, selDim)
            On Error GoTo 0
        End If
        If selDim = 0 Then Exit For
        d(selDim - 1) = d(selDim - 1) + 1
        selDim = arrDim

    End If

    For i = LBound(arr, selDim) To UBound(arr, selDim)

        d(selDim - 1) = i
        'read index
        If Not IsMissing(idx) Then
        Select Case arrDim
            Case Is = 1:        rArr = idx(d(0))
            Case Is = 2:        rArr = idx(d(0), d(1))
            Case Is = 3:        rArr = idx(d(0), d(1), d(2))
            Case Is = 4:        rArr = idx(d(0), d(1), d(2), d(3))
            Case Is = 5:        rArr = idx(d(0), d(1), d(2), d(3), d(4))
            Case Is = 6:        rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5))
            Case Is = 7:        rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6))
            Case Is = 8:        rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7))
            Case Is = 9:        rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8))
            Case Is = 10:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9))
            Case Is = 11:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10))
            Case Is = 12:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11))
            Case Is = 13:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12))
            Case Is = 14:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13))
            Case Is = 15:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14))
            Case Is = 16:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15))
            Case Is = 17:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16))
            Case Is = 18:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17))
            Case Is = 19:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18))
            Case Is = 20:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19))
            Case Is = 21:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20))
            Case Is = 22:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21))
            Case Is = 23:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22))
            Case Is = 24:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23))
            Case Is = 25:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24))
            Case Is = 26:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25))
            Case Is = 27:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26))
            Case Is = 28:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27))
            Case Is = 29:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28))
            Case Is = 30:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29))
            Case Is = 31:       rArr = idx(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29), d(30))
        End Select
        End If

        s = Split(rArr, del)
        'read target cell based on index
        If rArr <> "" Then
        Select Case arrDim
            Case Is = 1:        rArr = oArr(s(0))
            Case Is = 2:        rArr = oArr(s(0), s(1))
            Case Is = 3:        rArr = oArr(s(0), s(1), s(2))
            Case Is = 4:        rArr = oArr(s(0), s(1), s(2), s(3))
            Case Is = 5:        rArr = oArr(s(0), s(1), s(2), s(3), s(4))
            Case Is = 6:        rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5))
            Case Is = 7:        rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6))
            Case Is = 8:        rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7))
            Case Is = 9:        rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8))
            Case Is = 10:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9))
            Case Is = 11:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10))
            Case Is = 12:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11))
            Case Is = 13:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12))
            Case Is = 14:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13))
            Case Is = 15:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14))
            Case Is = 16:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15))
            Case Is = 17:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16))
            Case Is = 18:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17))
            Case Is = 19:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18))
            Case Is = 20:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19))
            Case Is = 21:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20))
            Case Is = 22:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21))
            Case Is = 23:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22))
            Case Is = 24:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23))
            Case Is = 25:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24))
            Case Is = 26:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24), s(25))
            Case Is = 27:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24), s(25), s(26))
            Case Is = 28:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24), s(25), s(26), s(27))
            Case Is = 29:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24), s(25), s(26), s(27), s(28))
            Case Is = 30:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24), s(25), s(26), s(27), s(28), s(29))
            Case Is = 31:       rArr = oArr(s(0), s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24), s(25), s(26), s(27), s(28), s(29), s(30))
        End Select
        End If
        'modify result based on requested action
        wArr = ArrayFunction(ActionTag, rArr, i, d, seq, sortDim, del)
        'write back calculated value
        Select Case arrDim
            Case Is = 1:        arr(d(0)) = wArr
            Case Is = 2:        arr(d(0), d(1)) = wArr
            Case Is = 3:        arr(d(0), d(1), d(2)) = wArr
            Case Is = 4:        arr(d(0), d(1), d(2), d(3)) = wArr
            Case Is = 5:        arr(d(0), d(1), d(2), d(3), d(4)) = wArr
            Case Is = 6:        arr(d(0), d(1), d(2), d(3), d(4), d(5)) = wArr
            Case Is = 7:        arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6)) = wArr
            Case Is = 8:        arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7)) = wArr
            Case Is = 9:        arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8)) = wArr
            Case Is = 10:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9)) = wArr
            Case Is = 11:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10)) = wArr
            Case Is = 12:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11)) = wArr
            Case Is = 13:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12)) = wArr
            Case Is = 14:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13)) = wArr
            Case Is = 15:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14)) = wArr
            Case Is = 16:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15)) = wArr
            Case Is = 17:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16)) = wArr
            Case Is = 18:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17)) = wArr
            Case Is = 19:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18)) = wArr
            Case Is = 20:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19)) = wArr
            Case Is = 21:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20)) = wArr
            Case Is = 22:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21)) = wArr
            Case Is = 23:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22)) = wArr
            Case Is = 24:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23)) = wArr
            Case Is = 25:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24)) = wArr
            Case Is = 26:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25)) = wArr
            Case Is = 27:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26)) = wArr
            Case Is = 28:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27)) = wArr
            Case Is = 29:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28)) = wArr
            Case Is = 30:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29)) = wArr
            Case Is = 31:       arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29), d(30)) = wArr
        End Select

    Next i

Next selDim

ArrayAction = arr

End Function

Private Function ArrayFunction(ByRef ActionTag As String, _
                               ByRef rArr As Variant, _
                               ByRef i As Integer, _
                               ByVal d As Variant, _
                               ByRef seq As Variant, _
                               ByRef sortDim As Integer, _
                               ByRef del As String) As Variant
' utility array function for several operations
Select Case ActionTag
    Case Is = "sortIndex", "filterIndex"
        d(sortDim - 1) = seq(d(sortDim - 1))
    Case Is = "fillZero"
        ArrayFunction = 0
        Exit Function
    Case Is = "fillSeries"
        ArrayFunction = i
        Exit Function
    Case Is = "fillSequence"
        ArrayFunction = seq(i)
        Exit Function
    Case Is = "sortArray", "filterArray"
        ArrayFunction = rArr
        Exit Function
    Case Is = "clearArray"
        ArrayFunction = Empty
        Exit Function
End Select

Select Case UBound(d)
    Case Is = 0:        ArrayFunction = d(0)
    Case Is = 1:        ArrayFunction = d(0) & del & d(1)
    Case Is = 2:        ArrayFunction = d(0) & del & d(1) & del & d(2)
    Case Is = 3:        ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3)
    Case Is = 4:        ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4)
    Case Is = 5:        ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5)
    Case Is = 6:        ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6)
    Case Is = 7:        ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7)
    Case Is = 8:        ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8)
    Case Is = 9:        ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9)
    Case Is = 10:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10)
    Case Is = 11:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11)
    Case Is = 12:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12)
    Case Is = 13:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13)
    Case Is = 14:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14)
    Case Is = 15:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15)
    Case Is = 16:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16)
    Case Is = 17:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17)
    Case Is = 18:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18)
    Case Is = 19:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19)
    Case Is = 20:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20)
    Case Is = 21:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21)
    Case Is = 22:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22)
    Case Is = 23:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23)
    Case Is = 24:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23) & del & d(24)
    Case Is = 25:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23) & del & d(24) & del & d(25)
    Case Is = 26:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23) & del & d(24) & del & d(25) & del & d(26)
    Case Is = 27:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23) & del & d(24) & del & d(25) & del & d(26) & del & d(27)
    Case Is = 28:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23) & del & d(24) & del & d(25) & del & d(26) & del & d(27) & del & d(28)
    Case Is = 29:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23) & del & d(24) & del & d(25) & del & d(26) & del & d(27) & del & d(28) & del & d(29)
    Case Is = 30:       ArrayFunction = d(0) & del & d(1) & del & d(2) & del & d(3) & del & d(4) & del & d(5) & del & d(6) & del & d(7) & del & d(8) & del & d(9) & del & d(10) & del & d(11) & del & d(12) & del & d(13) & del & d(14) & del & d(15) & del & d(16) & del & d(17) & del & d(18) & del & d(19) & del & d(20) & del & d(21) & del & d(22) & del & d(23) & del & d(24) & del & d(25) & del & d(26) & del & d(27) & del & d(28) & del & d(29) & del & d(30)
End Select

End Function

Public Function RedimArray(ByRef arr As Variant, ByRef d As Variant) As Boolean
' array redimension function based on d array's values
    Select Case UBound(d)
        Case Is = 0:        ReDim arr(d(0))
        Case Is = 1:        ReDim arr(d(0), d(1))
        Case Is = 2:        ReDim arr(d(0), d(1), d(2))
        Case Is = 3:        ReDim arr(d(0), d(1), d(2), d(3))
        Case Is = 4:        ReDim arr(d(0), d(1), d(2), d(3), d(4))
        Case Is = 5:        ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5))
        Case Is = 6:        ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6))
        Case Is = 7:        ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7))
        Case Is = 8:        ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8))
        Case Is = 9:        ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9))
        Case Is = 10:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10))
        Case Is = 11:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11))
        Case Is = 12:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12))
        Case Is = 13:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13))
        Case Is = 14:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14))
        Case Is = 15:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15))
        Case Is = 16:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16))
        Case Is = 17:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17))
        Case Is = 18:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18))
        Case Is = 19:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19))
        Case Is = 20:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20))
        Case Is = 21:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21))
        Case Is = 22:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22))
        Case Is = 23:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23))
        Case Is = 24:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24))
        Case Is = 25:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25))
        Case Is = 26:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26))
        Case Is = 27:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27))
        Case Is = 28:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28))
        Case Is = 29:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29))
        Case Is = 30:       ReDim arr(d(0), d(1), d(2), d(3), d(4), d(5), d(6), d(7), d(8), d(9), d(10), d(11), d(12), d(13), d(14), d(15), d(16), d(17), d(18), d(19), d(20), d(21), d(22), d(23), d(24), d(25), d(26), d(27), d(28), d(29), d(30))
    End Select

End Function

Private Function SortSeq(ByRef iArr As Variant, _
                         ByRef sArr As Variant, _
                         ByRef iDnRow As Long, _
                         ByRef iUpRow As Long, _
                Optional ByRef ascend As Boolean = True) As Variant
' unidimensional sort function used as sequence builder for SortArray function
Dim oArr As Variant, vArr As Variant
Dim vDnRow As Long, vUpRow As Long

vDnRow = iDnRow
vUpRow = iUpRow
oArr = iArr((iDnRow + iUpRow) \ 2)

While (vDnRow <= vUpRow)

If ascend = True Then
    While (iArr(vDnRow) < oArr And vDnRow < iUpRow)
       vDnRow = vDnRow + 1
    Wend
    While (oArr < iArr(vUpRow) And vUpRow > iDnRow)
       vUpRow = vUpRow - 1
    Wend
Else
    While (iArr(vDnRow) > oArr And vDnRow < iUpRow)
       vDnRow = vDnRow + 1
    Wend
    While (oArr > iArr(vUpRow) And vUpRow > iDnRow)
       vUpRow = vUpRow - 1
    Wend
End If

If (vDnRow <= vUpRow) Then
   vArr = iArr(vDnRow)
   iArr(vDnRow) = iArr(vUpRow)
   iArr(vUpRow) = vArr
   vArr = sArr(vDnRow)
   sArr(vDnRow) = sArr(vUpRow)
   sArr(vUpRow) = vArr
   vDnRow = vDnRow + 1
   vUpRow = vUpRow - 1
End If

Wend

If (iDnRow < vUpRow) Then SortSeq iArr, sArr, iDnRow, vUpRow, ascend
If (vDnRow < iUpRow) Then SortSeq iArr, sArr, vDnRow, iUpRow, ascend

SortSeq = sArr

End Function

Private Function FilterSeq(ByRef arr As Variant, _
                           ByRef sArr As Variant, _
                           ByRef LB As Long, _
                           ByRef UB As Long, _
                           ByRef operator As String, _
                           ByRef operand As String) As Variant
' unidimensional filter function used as sequence builder for FilterArray function
' Available operators for this function could be found bellow, and the list can be completed with desired operations
Dim i As Integer, k As Integer

For i = LB To UB

    Select Case operator
        Case Is = "GraterThan"
            If arr(i) > operand Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "GraterOrEqual"
            If arr(i) >= operand Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "LessThan"
            If arr(i) < operand Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "LessOrEqual"
            If arr(i) <= operand Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "Equals"
            If arr(i) = operand Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "NotEquals"
            If arr(i) <> operand Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "Contains"
            If Len(arr(i)) - Len(Replace$(arr(i), operand, "")) > 0 Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "DoesNotContain"
            If Len(arr(i)) - Len(Replace$(arr(i), operand, "")) = 0 Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "ContainRegex"
            If ExtractRegex(arr(i), operand) <> "" Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "DoesNotContainRegex"
            If ExtractRegex(arr(i), operand) = "" Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "BeginsWith"
            If Left$(arr(i), Len(operand)) = operand Then
            sArr(k) = i
            k = k + 1
            End If
        Case Is = "EndsWith"
            If Right$(arr(i), Len(operand)) = operand Then
            sArr(k) = i
            k = k + 1
            End If
    End Select

Next i

If k = 0 Then
    FilterSeq = sArr
    Exit Function
Else
    ReDim Preserve sArr(k - 1)
End If

FilterSeq = sArr

End Function

Function RegEx(strInput As String, matchPattern As String, Optional ByVal outputPattern As String = "$0") As Variant
Dim inputRegexObj As New VBScript_RegExp_55.RegExp, outputRegexObj As New VBScript_RegExp_55.RegExp, outReplaceRegexObj As New VBScript_RegExp_55.RegExp
Dim inputMatches As Object, replaceMatches As Object, replaceMatch As Object
Dim replaceNumber As Integer

With inputRegexObj
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = matchPattern
End With
With outputRegexObj
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = "\$(\d+)"
End With
With outReplaceRegexObj
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
End With

Set inputMatches = inputRegexObj.Execute(strInput)
If inputMatches.Count = 0 Then
    RegEx = False
Else
    Set replaceMatches = outputRegexObj.Execute(outputPattern)
    For Each replaceMatch In replaceMatches
        replaceNumber = replaceMatch.SubMatches(0)
        outReplaceRegexObj.Pattern = "\$" & replaceNumber

        If replaceNumber = 0 Then
            outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).Value)
        Else
            If replaceNumber > inputMatches(0).SubMatches.Count Then
                'regex = "A to high $ tag found. Largest allowed is $" & inputMatches(0).SubMatches.Count & "."
                RegEx = CVErr(xlErrValue)
                Exit Function
            Else
                outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).SubMatches(replaceNumber - 1))
            End If
        End If
    Next
    RegEx = outputPattern
End If

End Function

Function StripRegex(MyString As Range, MyPattern As Range) As String

Dim RegEx As New RegExp
Dim strPattern As String
Dim strInput As String
Dim strReplace As String
Dim strOutput As String

strPattern = MyPattern.Value

If strPattern <> "" Then
    strInput = MyString.Value
    strReplace = ""

    With RegEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = strPattern
    End With

    If RegEx.Test(strInput) Then
        StripRegex = RegEx.Replace(strInput, strReplace)
    Else
        StripRegex = "Not found"
    End If
End If

End Function

Function ExtractAllRegexes(ByVal MyString As String, _
                      ByVal MyPattern As String, _
                      Optional seperator As String = ", ") As String

Dim i As Long, j As Long
Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

With RE
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = MyPattern
End With

Set allMatches = RE.Execute(MyString)

For i = 0 To allMatches.Count - 1
    For j = 0 To allMatches.item(i).SubMatches.Count - 1
        result = result & seperator & allMatches.item(i).SubMatches.item(j)
    Next
Next

If Len(result) <> 0 Then
    result = Right(result, Len(result) - Len(seperator))
Else
    ExtractAllRegexes = "Not found"
End If

ExtractAllRegexes = result

End Function

Function ExtractRegex(ByVal TextToSearch As String, ByVal Pattern As String) As String
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")

With RE
    .MultiLine = False
    .Global = False
    .IgnoreCase = False
    .Pattern = Pattern
End With

Set REMatches = RE.Execute(TextToSearch)
If REMatches.Count > 0 Then
    ExtractRegex = REMatches(0)
Else
    ExtractRegex = vbNullString
End If

End Function

A simple test sub (feel free to explore various combinations of functions)

Sub testSortArray()

Dim arr As Variant, indexArr As Variant, s As Variant

ReDim arr(1, 1, 5)

arr(0, 0, 0) = 0
arr(0, 0, 1) = 1
arr(0, 0, 2) = 2
arr(0, 0, 3) = 3
arr(0, 0, 4) = 4
arr(0, 0, 5) = 5
arr(0, 1, 0) = 10
arr(0, 1, 1) = 11
arr(0, 1, 2) = 12
arr(0, 1, 3) = 13
arr(0, 1, 4) = 14
arr(0, 1, 5) = 15
arr(1, 0, 0) = 100
arr(1, 0, 1) = 101
arr(1, 0, 2) = 102
arr(1, 0, 3) = 103
arr(1, 0, 4) = 104
arr(1, 0, 5) = 105
arr(1, 1, 0) = 110
arr(1, 1, 1) = 111
arr(1, 1, 2) = 112
arr(1, 1, 3) = 113
arr(1, 1, 4) = 114
arr(1, 1, 5) = 115

arr = FilterArray(arr, "(1,1,0)", 3, "GraterOrEqual", 114)
'arr = SortArray(arr, "(1,1,0)", 3, False)

'indexArr = ArrayAction(arr)

End Sub
\$\endgroup\$
  • \$\begingroup\$ Just wondering, why didn't you go the whole hog and dd support for the maximum 32 dimensions while you were doing all that copy-paste? \$\endgroup\$ – Kaz Dec 18 '15 at 23:21
15
\$\begingroup\$

Stop. Close Excel. Take a deep breath.

Now go and get an actual Database. MS Access. MySQL is free and Open-Source. It doesn't really matter. What matters is that Excel is not the program to be doing this in. At all. 10-Dimensions was already excessive. 31 is a severe case of Over-Engineering.

Unless you've been specifically required to include support for that number of dimensions, it's almost certainly a waste of time and development effort to do so.

Just think for a second about what a 31-dimensional array would involve. Assume that every dimensions has just 2 items. your 31-dimensional array now has 2^31 or ~1 Billion variables. VBA tends to run out of memory at around 100 Million variables (yet alone doing anything with them).

You are Never going to need to sort a 31-dimensional array. You are never even going to see one. I can't think of a single good reason for VBA arrays to ever go above 4 dimensions. And it literally doesn't have enough memory to create an array of that size anyway.


To reiterate: You shouldn't be doing this in the first place, but if you're going to, for gods' sake get a proper database.


As for your code itself:

I would discuss your confusing and unclear variable naming, but I've already reviewed it twice before and I would just be repeating myself here.

Though I will say: It's been 3 iterations and you're still using s and d as variable names for Data Arrays. Fix it.

\$\endgroup\$
  • \$\begingroup\$ First of all, who told that it is for excel? Second, why did you supposed that all dimensions must have minimum 2 items? A lot of parameters could be just static as a reference... Third, I already use several MS SQL servers... \$\endgroup\$ – Sorin GFS Dec 19 '15 at 0:00
  • 3
    \$\begingroup\$ 1) Well, you did tag it as Excel. 2) A unit-length dimension is not a dimension, it's a property, and should be expressed that way. 3) Cool, but that just begs the question, why on earth are you trying to do this in VBA? \$\endgroup\$ – Kaz Dec 19 '15 at 12:54
  • 2
    \$\begingroup\$ Speaking of, I removed the excel tag because the object model is never referenced. \$\endgroup\$ – RubberDuck Dec 19 '15 at 14:06
  • \$\begingroup\$ Excel offers a good environment for testing the code during work. Especially for codes that involves calculations. I did tag it as excel because works in excel too, you don't need to use all capabilities, it works with 3-4 dimensions too. It took me less than an hour to convert the code into vb.net code, it could be converted in any language you need easily. I didn't do any tests yet, but if you like I could post the vb.net version of the code too.. Think another way: imagine this huge array containing a single bit in every cell. To be continued... \$\endgroup\$ – Sorin GFS Dec 19 '15 at 14:27
  • 3
    \$\begingroup\$ Those are all cool ideas, and I would suggest that for each of them, this is not the best way to go about it, and definitely not the right language. \$\endgroup\$ – Kaz Dec 19 '15 at 14:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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