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:
- 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. - Necessary regex functions (adapted from code found on the Internet and requires Microsoft VBScript Regular Expressions 5.5 library).
- All array functions are extended to 31 dimensions.
- Existing intermediary functions are versatile; it could be used for various array operations.
- 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