I'm trying to write a class that simplifies the most common operations with arrays and then I want to distribute... Maybe it can help someone...
But I'm facing some problems in make the object simple to use and intuitive.
Here a summary of the public methods:
- Array to range
- Array to string
- Array to text file
- Array Filter
- Merge Arrays
- Range to array
- Array Sort
- String to array
- Text file to array
- Transpose
Array Filter: Here I have to allow the user to set the filters he needs and that means allow public methods that mean nothing outside the filter method.
Those are the methods:
- FilterIncludeEquals
- FilterExcludeEquals
- FilterIncludeIfBetween
- FilterIncludeIfContains
and then:
- FilterApplyTo
How To use (complete code on class module named ArrayManipulation):
Public Sub Test()
Dim testObject As ArrayManipulation
Set testObject = New ArrayManipulation
Dim arrayOfNumbers As Variant
ReDim arrayOfNumbers(12)
Dim numbers As Long
For numbers = 0 To 11
arrayOfNumbers(numbers) = numbers
Next
With testObject
' setup filters
.FilterExcludeEquals 3, 0 'column is not considered for 1d arrays
.FilterIncludeIfBetween 1, 4, 0
' filter the array
.FilterApplyTo arrayOfNumbers
' this create a txt file storing the array
.ArrayToTextFile arrayOfNumbers, Environ("USERPROFILE") & "\Desktop\Test.txt"
' this read the array from the just created file
.TextFileToArray Environ("USERPROFILE") & "\Desktop\Test.txt", arrayOfNumbers
' this write the array on activesheet of you activeworkbook, starting from D3
.ArrayToRange arrayOfNumbers, Cells(3, 4)
End With
End Sub
I think the best solution would be to create a second object and then compose the two class and expose a property that returns the "filter" object. But I'm concerned that two modules are less immediate and maybe a person that is not familiar with the IDE can find it more difficult.. So I've decided to put an "Filter" suffix on all filter-related methods.
Do you have any advice?
Sort: At the moment the sort use merge sort but I want to try to write also insertion sort and introsort (as soon as I'll understand it) but more importantly, how can I understand how to sort by multiple columns? I can't find examples that I can understand... How did you do?
Results: All the methods require byRef arguments and the results of the routine overwrite the arguments. Is this approach acceptable? Or is necessary or good practice to use functions?
I would like to have a feedback on the code and on the idea.. Thank you!
Option Explicit
Private pColumnsToReturn As Variant
Private pFiltersCollection As Collection
Private pPartialMatchColl As Collection
Private Enum filterType
negativeMatch = -1
exactMatch = 0
isBetween = 1
contains = 2
End Enum
Public Property Let ColumnsToReturn(arr As Variant)
pColumnsToReturn = arr
End Property
' FILTER METHODS ******************************************************************
Public Sub FilterIncludeEquals(ByRef equalTo As Variant, ByRef inColumn As Long, _
Optional ByRef isCaseSensitive As Boolean = False)
If inColumn > -1 Then
Dim thisFilter As Collection
Dim thisFilterType As filterType
Set thisFilter = New Collection
thisFilterType = exactMatch
With thisFilter
.Add thisFilterType
.Add inColumn
.Add IIf(isCaseSensitive, equalTo, LCase(equalTo))
.Add isCaseSensitive
End With
If pFiltersCollection Is Nothing Then Set pFiltersCollection = New Collection
pFiltersCollection.Add thisFilter
Set thisFilter = Nothing
End If
End Sub
Public Sub FilterExcludeEquals(ByRef equalTo As Variant, ByRef inColumn As Long, _
Optional ByRef isCaseSensitive As Boolean = False)
If inColumn > -1 Then
Dim thisFilter As Collection
Dim thisFilterType As filterType
Set thisFilter = New Collection
thisFilterType = negativeMatch
With thisFilter
.Add thisFilterType
.Add inColumn
.Add IIf(isCaseSensitive, equalTo, LCase(equalTo))
.Add isCaseSensitive
End With
If pFiltersCollection Is Nothing Then Set pFiltersCollection = New Collection
pFiltersCollection.Add thisFilter
Set thisFilter = Nothing
End If
End Sub
Public Sub FilterIncludeIfBetween(ByRef lowLimit As Variant, ByRef highLimit As Variant, ByRef inColumn As Long)
If inColumn > -1 Then
Dim thisFilter As Collection
Dim thisFilterType As filterType
Set thisFilter = New Collection
thisFilterType = isBetween
With thisFilter
.Add thisFilterType
.Add inColumn
.Add lowLimit
.Add highLimit
End With
If pFiltersCollection Is Nothing Then Set pFiltersCollection = New Collection
pFiltersCollection.Add thisFilter
Set thisFilter = Nothing
End If
End Sub
Public Sub FilterIncludeIfContains(ByRef substring As String, Optional ByRef inColumns As Variant = 1)
If IsArray(inColumns) Or IsNumeric(inColumns) Then
Dim thisFilterType As filterType
Set pPartialMatchColl = New Collection
thisFilterType = contains
With pPartialMatchColl
.Add thisFilterType
.Add inColumns
.Add substring
End With
End If
End Sub
Public Sub FilterApplyTo(ByRef originalArray As Variant)
If Not IsArray(originalArray) Then Exit Sub
If isSingleDimensionalArray(originalArray) Then
filterOneDimensionalArray originalArray
Else
filterTwoDimensionalArray originalArray
End If
End Sub
Private Sub filterTwoDimensionalArray(ByRef originalArray As Variant)
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim row As Long
Dim col As Long
Dim arrayOfColumnToReturn As Variant
Dim partialMatchColumnsArray As Variant
Dim result As Variant
result = -1
arrayOfColumnToReturn = pColumnsToReturn
If Not pPartialMatchColl Is Nothing Then partialMatchColumnsArray = pPartialMatchColl(2)
' If the caller don't pass the array of column to return
' create an array with all the columns and preserve the order
If Not IsArray(arrayOfColumnToReturn) Then
ReDim arrayOfColumnToReturn(LBound(originalArray, 2) To UBound(originalArray, 2))
For col = LBound(originalArray, 2) To UBound(originalArray, 2)
arrayOfColumnToReturn(col) = col
Next col
End If
' If the caller don't pass an array for partial match
' check if it pass the special value 1, if true the
' partial match will be performed on values in columns to return
If Not IsArray(partialMatchColumnsArray) Then
If partialMatchColumnsArray = 1 Then partialMatchColumnsArray = arrayOfColumnToReturn
End If
firstRow = LBound(originalArray, 1)
lastRow = UBound(originalArray, 1)
' main loop
Dim keepCount As Long
Dim filter As Variant
Dim currentFilterType As filterType
ReDim arrayOfRowsToKeep(lastRow - firstRow + 1) As Variant
keepCount = 0
For row = firstRow To lastRow
' exact, excluse and between checks
If Not pFiltersCollection Is Nothing Then
For Each filter In pFiltersCollection
currentFilterType = filter(1)
Select Case currentFilterType
Case negativeMatch
If filter(4) Then
If originalArray(row, filter(2)) = filter(3) Then GoTo Skip
Else
If LCase(originalArray(row, filter(2))) = filter(3) Then GoTo Skip
End If
Case exactMatch
If filter(4) Then
If originalArray(row, filter(2)) <> filter(3) Then GoTo Skip
Else
If LCase(originalArray(row, filter(2))) <> filter(3) Then GoTo Skip
End If
Case isBetween
If originalArray(row, filter(2)) < filter(3) _
Or originalArray(row, filter(2)) > filter(4) Then GoTo Skip
End Select
Next filter
End If
' partial match check
If Not pPartialMatchColl Is Nothing Then
If IsArray(partialMatchColumnsArray) Then
For col = LBound(partialMatchColumnsArray) To UBound(partialMatchColumnsArray)
If InStr(1, originalArray(row, partialMatchColumnsArray(col)), pPartialMatchColl(3), vbTextCompare) > 0 Then
GoTo Keep
End If
Next
GoTo Skip
End If
End If
Keep:
arrayOfRowsToKeep(keepCount) = row
keepCount = keepCount + 1
Skip:
Next row
' create results array
If keepCount > 0 Then
firstRow = LBound(originalArray, 1)
lastRow = LBound(originalArray, 1) + keepCount - 1
firstColumn = LBound(originalArray, 2)
lastColumn = LBound(originalArray, 2) + UBound(arrayOfColumnToReturn) - LBound(arrayOfColumnToReturn)
ReDim result(firstRow To lastRow, firstColumn To lastColumn)
For row = firstRow To lastRow
For col = firstColumn To lastColumn
result(row, col) = originalArray(arrayOfRowsToKeep(row - firstRow), arrayOfColumnToReturn(col - firstColumn + LBound(arrayOfColumnToReturn)))
Next col
Next row
End If
originalArray = result
If IsArray(result) Then Erase result
End Sub
Private Sub filterOneDimensionalArray(ByRef originalArray As Variant)
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim row As Long
Dim col As Long
Dim arrayOfColumnToReturn As Variant
Dim partialMatchColumnsArray As Variant
Dim result As Variant
result = -1
firstRow = LBound(originalArray)
lastRow = UBound(originalArray)
' main loop
Dim keepCount As Long
Dim filter As Variant
Dim currentFilterType As filterType
ReDim arrayOfRowsToKeep(lastRow - firstRow + 1) As Variant
keepCount = 0
For row = firstRow To lastRow
' exact, excluse and between checks
If Not pFiltersCollection Is Nothing Then
For Each filter In pFiltersCollection
currentFilterType = filter(1)
Select Case currentFilterType
Case negativeMatch
If filter(4) Then
If originalArray(row) = filter(3) Then GoTo Skip
Else
If LCase(originalArray(row)) = filter(3) Then GoTo Skip
End If
Case exactMatch
If filter(4) Then
If originalArray(row) <> filter(3) Then GoTo Skip
Else
If LCase(originalArray(row)) <> filter(3) Then GoTo Skip
End If
Case isBetween
If originalArray(row) < filter(3) _
Or originalArray(row) > filter(4) Then GoTo Skip
End Select
Next filter
End If
' partial match check
If Not pPartialMatchColl Is Nothing Then
If InStr(1, originalArray(row), pPartialMatchColl(3), vbTextCompare) > 0 Then
GoTo Keep
End If
GoTo Skip
End If
Keep:
arrayOfRowsToKeep(keepCount) = row
keepCount = keepCount + 1
Skip:
Next row
' create results array
If keepCount > 0 Then
firstRow = LBound(originalArray, 1)
lastRow = LBound(originalArray, 1) + keepCount - 1
ReDim result(firstRow To lastRow)
For row = firstRow To lastRow
result(row) = originalArray(arrayOfRowsToKeep(row - firstRow))
Next row
End If
originalArray = result
If IsArray(result) Then Erase result
End Sub
' TRANSPOSE ARRAY ******************************************************************
Public Sub Transpose(ByRef originalArray As Variant)
If Not IsArray(originalArray) Then Exit Sub
If isSingleDimensionalArray(originalArray) Then Exit Sub
Dim row As Long
Dim column As Long
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
firstRow = LBound(originalArray, 1)
firstColumn = LBound(originalArray, 2)
lastRow = UBound(originalArray, 1)
lastColumn = UBound(originalArray, 2)
ReDim tempArray(firstColumn To lastColumn, firstRow To lastRow) As Variant
For row = firstColumn To lastColumn
For column = firstRow To lastRow
tempArray(row, column) = originalArray(column, row)
Next column
Next row
originalArray = tempArray
Erase tempArray
End Sub
Private Function isSingleDimensionalArray(myArray As Variant) As Boolean
Dim testDimension As Long
testDimension = -1
On Error Resume Next
testDimension = UBound(myArray, 2)
On Error GoTo 0
isSingleDimensionalArray = (testDimension = -1)
End Function
' ARRAY TO STRING ******************************************************************
Public Sub ArrayToString(ByRef originalArray As Variant, ByRef stringToReturn As String, _
Optional colSeparator As String = ",", Optional rowSeparator As String = ";")
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim row As Long
Dim col As Long
If Not IsArray(originalArray) Then Exit Sub
' Join single dimension array
If isSingleDimensionalArray(originalArray) Then
stringToReturn = Join(originalArray, colSeparator)
Exit Sub
End If
firstRow = LBound(originalArray, 1)
lastRow = UBound(originalArray, 1)
firstColumn = LBound(originalArray, 2)
lastColumn = UBound(originalArray, 2)
ReDim rowArray(firstRow To lastRow) As Variant
ReDim tempArray(firstColumn To lastColumn) As Variant
For row = firstRow To lastRow
' fill array with values of the entire row
For col = firstColumn To lastColumn
tempArray(col) = originalArray(row, col)
Next col
rowArray(row) = Join(tempArray, colSeparator)
Next row
' convert rowArray to string
stringToReturn = Join(rowArray, rowSeparator)
Erase rowArray
Erase tempArray
End Sub
' STRING TO ARRAY ******************************************************************
Public Sub StringToArray(ByRef myString As String, ByRef arrayToReturn As Variant, _
Optional colSeparator As String = ",", Optional rowSeparator As String = ";")
If myString = vbNullString Then Exit Sub
Dim rowArr As Variant
ReDim tempArr(0, 0) As Variant
Dim colArr As Variant
Dim firstRow As Long
Dim lastRow As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim row As Long
Dim col As Long
' get the dimensions of the resulting array
rowArr = Split(myString, rowSeparator)
firstRow = LBound(rowArr)
lastRow = UBound(rowArr)
colArr = Split(rowArr(firstRow), colSeparator)
firstColumn = LBound(colArr)
lastColumn = UBound(colArr)
' return one dimension array
If firstColumn = lastColumn Then
arrayToReturn = rowArr
Exit Sub
End If
' dim result array
ReDim tempArr(firstRow To lastRow, firstColumn To lastColumn)
For row = firstRow To lastRow
' split each row
colArr = Split(rowArr(row), colSeparator)
For col = firstColumn To lastColumn
' fill result array
If IsDate(colArr(col)) Then
tempArr(row, col) = CDate(colArr(col))
Else
tempArr(row, col) = colArr(col)
End If
Next col
Next row
arrayToReturn = tempArr
Erase tempArr
Erase rowArr
Erase colArr
End Sub
' ARRAY TO TEXT FILE ******************************************************************
Public Sub ArrayToTextFile(ByRef originalArray As Variant, ByRef fullPath As String, _
Optional colSeparator As String = ",", Optional rowSeparator As String = ";")
Dim fso As FileSystemObject
Dim resultingString As String
Set fso = New FileSystemObject
Me.ArrayToString originalArray, resultingString, colSeparator, rowSeparator
With fso.CreateTextFile(fullPath)
.Write resultingString
End With
Set fso = Nothing
End Sub
' TEXT FILE TO ARRAY ******************************************************************
Public Sub TextFileToArray(ByRef fullPath As String, ByRef arrayToReturn As Variant, _
Optional colSeparator As String = ",", Optional rowSeparator As String = ";")
Dim fso As FileSystemObject
Dim resultingString As String
Set fso = New FileSystemObject
If fso.FileExists(fullPath) Then
With fso.OpenTextFile(fullPath)
resultingString = .ReadAll
End With
Me.StringToArray resultingString, arrayToReturn, colSeparator, rowSeparator
End If
Set fso = Nothing
End Sub
' ARRAY TO RANGE ******************************************************************
Public Sub ArrayToRange(ByRef myArray As Variant, ByRef TopLeftCell As Range)
Dim totRows As Long
Dim totColumns As Long
If Not IsArray(myArray) Then Exit Sub
If isSingleDimensionalArray(myArray) Then
totRows = 1
totColumns = UBound(myArray) - LBound(myArray) + 1
Else
totRows = UBound(myArray, 1) - LBound(myArray, 1) + 1
totColumns = UBound(myArray, 2) - LBound(myArray, 2) + 1
End If
TopLeftCell.Resize(totRows, totColumns).value = myArray
End Sub
' RANGE TO ARRAY *******************************************************************
Public Sub RangeToArray(ByRef TopLeftCell As Range, ByRef ResultingArray As Variant)
ResultingArray = TopLeftCell.CurrentRegion.value
End Sub
' MERGE *****************************************************************************
Public Sub MergeArrays(ByRef MainArray As Variant, ByRef ArrayOfArrays As Variant)
If isSingleDimensionalArray(MainArray) Then
MergeArrays1D MainArray, ArrayOfArrays
Else
MergeArrays2D MainArray, ArrayOfArrays
End If
End Sub
Private Sub MergeArrays2D(ByRef MainArray As Variant, ByRef ArrayOfArrays As Variant)
Dim arrayOfColumnToReturn As Variant
Dim totRows As Long
Dim row As Long
Dim column As Long
Dim resultRow As Long
Dim currentArray As Variant
Dim i As Long
If Not IsArray(MainArray) Then Exit Sub
arrayOfColumnToReturn = pColumnsToReturn
' If the caller don't pass the array of column to return
' create an array with all the columns and preserve the order
If Not IsArray(arrayOfColumnToReturn) Then
ReDim arrayOfColumnToReturn(LBound(MainArray, 2) To UBound(MainArray, 2))
For column = LBound(MainArray, 2) To UBound(MainArray, 2)
arrayOfColumnToReturn(column) = column
Next column
End If
' calculate dimensions of the result array
totRows = UBound(MainArray)
For row = LBound(ArrayOfArrays) To UBound(ArrayOfArrays)
totRows = totRows + UBound(ArrayOfArrays(row)) - LBound(ArrayOfArrays(row)) + 1
Next row
ReDim tempArray(LBound(MainArray) To totRows, LBound(arrayOfColumnToReturn) To UBound(arrayOfColumnToReturn)) As Variant
' fill result array from main array
For row = LBound(MainArray) To UBound(MainArray)
For column = LBound(arrayOfColumnToReturn) To UBound(arrayOfColumnToReturn)
tempArray(row, column) = MainArray(row, column)
Next column
Next row
resultRow = row
' fill result array from ArrayOfArrays
For i = LBound(ArrayOfArrays) To UBound(ArrayOfArrays)
If IsArray(ArrayOfArrays(i)) Then
currentArray = ArrayOfArrays(i)
For row = LBound(currentArray) To UBound(currentArray)
For column = LBound(arrayOfColumnToReturn) To UBound(arrayOfColumnToReturn)
tempArray(resultRow, column) = currentArray(row, column)
Next column
resultRow = resultRow + 1
Next row
End If
Next i
MainArray = tempArray
End Sub
Private Sub MergeArrays1D(ByRef MainArray As Variant, ByRef ArrayOfArrays As Variant)
Dim totRows As Long
Dim row As Long
Dim resultRow As Long
Dim currentArray As Variant
Dim i As Long
If Not IsArray(MainArray) Then Exit Sub
' calculate dimensions of the result array
totRows = UBound(MainArray)
For row = LBound(ArrayOfArrays) To UBound(ArrayOfArrays)
totRows = totRows + UBound(ArrayOfArrays(row)) - LBound(ArrayOfArrays(row)) + 1
Next row
ReDim tempArray(LBound(MainArray) To totRows) As Variant
' fill result array from main array
For row = LBound(MainArray) To UBound(MainArray)
tempArray(row) = MainArray(row)
Next row
resultRow = row
' fill result array from ArrayOfArrays
For i = LBound(ArrayOfArrays) To UBound(ArrayOfArrays)
If IsArray(ArrayOfArrays(i)) Then
currentArray = ArrayOfArrays(i)
For row = LBound(currentArray) To UBound(currentArray)
tempArray(resultRow) = currentArray(row)
resultRow = resultRow + 1
Next row
End If
Next i
MainArray = tempArray
End Sub
' SORT ****************************************************************************************
Public Sub Sort(ByRef myArray As Variant, Optional ByVal columnToSort As Long, _
Optional Ascending As Boolean = True)
If Not IsArray(myArray) Then Exit Sub
If isSingleDimensionalArray(myArray) Then
Divide1D myArray, Ascending
Else
Divide2D myArray, columnToSort, Ascending
End If
End Sub
Private Sub Divide1D(thisArray As Variant, _
Optional Ascending As Boolean = True)
Dim Length As Long
Dim i As Long
Length = UBound(thisArray) - LBound(thisArray)
If Length < 1 Then Exit Sub
Dim Pivot As Long
Pivot = Length / 2
ReDim leftArray(Pivot) As Variant
ReDim rightArray(Length - Pivot - 1) As Variant
Dim Index As Long
For Index = LBound(thisArray) To Pivot + LBound(thisArray)
leftArray(i) = thisArray(Index)
i = i + 1
Next Index
i = 0
For Index = Index To UBound(thisArray)
rightArray(i) = thisArray(Index)
i = i + 1
Next Index
Divide1D leftArray
Divide1D rightArray
Merge1D leftArray, rightArray, thisArray, Ascending
End Sub
Private Sub Merge1D(leftArray As Variant, rightArray As Variant, _
arrayToSort As Variant, Ascending As Boolean)
Dim lLength As Long
Dim rLength As Long
Dim leftLowest As Long
Dim rightLowest As Long
Dim resultIndex As Long
resultIndex = IIf(Ascending, LBound(arrayToSort), UBound(arrayToSort))
lLength = UBound(leftArray)
rLength = UBound(rightArray)
Do While leftLowest <= lLength And rightLowest <= rLength
If leftArray(leftLowest) <= rightArray(rightLowest) Then
arrayToSort(resultIndex) = leftArray(leftLowest)
leftLowest = leftLowest + 1
Else
arrayToSort(resultIndex) = rightArray(rightLowest)
rightLowest = rightLowest + 1
End If
resultIndex = resultIndex + IIf(Ascending, 1, -1)
Loop
Do While leftLowest <= lLength
arrayToSort(resultIndex) = leftArray(leftLowest)
leftLowest = leftLowest + 1
resultIndex = resultIndex + IIf(Ascending, 1, -1)
Loop
Do While rightLowest <= rLength
arrayToSort(resultIndex) = rightArray(rightLowest)
rightLowest = rightLowest + 1
resultIndex = resultIndex + IIf(Ascending, 1, -1)
Loop
End Sub
Private Sub Divide2D(thisArray As Variant, ByRef columnToSort As Long, _
Optional Ascending As Boolean = True)
Dim Length As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim column As Long
Dim i As Long
firstColumn = LBound(thisArray, 2)
lastColumn = UBound(thisArray, 2)
Length = UBound(thisArray) - LBound(thisArray)
If Length < 1 Then Exit Sub
Dim Pivot As Long
Pivot = Length / 2
ReDim leftArray(0 To Pivot, firstColumn To lastColumn) As Variant
ReDim rightArray(0 To Length - Pivot - 1, firstColumn To lastColumn) As Variant
Dim Index As Long
For Index = LBound(thisArray) To Pivot + LBound(thisArray)
For column = firstColumn To lastColumn
leftArray(i, column) = thisArray(Index, column)
Next column
i = i + 1
Next Index
i = 0
For Index = Index To UBound(thisArray)
For column = firstColumn To lastColumn
rightArray(i, column) = thisArray(Index, column)
Next column
i = i + 1
Next Index
Divide2D leftArray, columnToSort
Divide2D rightArray, columnToSort
Merge2D leftArray, rightArray, thisArray, Ascending, columnToSort
End Sub
Private Sub Merge2D(leftArray As Variant, rightArray As Variant, _
arrayToSort As Variant, Ascending As Boolean, ByRef columnToSort As Long)
Dim lLength As Long
Dim rLength As Long
Dim leftLowest As Long
Dim rightLowest As Long
Dim resultIndex As Long
Dim firstColumn As Long
Dim lastColumn As Long
Dim column As Long
resultIndex = IIf(Ascending, LBound(arrayToSort), UBound(arrayToSort))
firstColumn = LBound(arrayToSort, 2)
lastColumn = UBound(arrayToSort, 2)
leftLowest = LBound(leftArray)
rightLowest = LBound(rightArray)
lLength = UBound(leftArray)
rLength = UBound(rightArray)
Do While leftLowest <= lLength And rightLowest <= rLength
If leftArray(leftLowest, columnToSort) <= rightArray(rightLowest, columnToSort) Then
For column = firstColumn To lastColumn
arrayToSort(resultIndex, column) = leftArray(leftLowest, column)
Next column
leftLowest = leftLowest + 1
Else
For column = firstColumn To lastColumn
arrayToSort(resultIndex, column) = rightArray(rightLowest, column)
Next column
rightLowest = rightLowest + 1
End If
resultIndex = resultIndex + IIf(Ascending, 1, -1)
Loop
Do While leftLowest <= lLength
For column = firstColumn To lastColumn
arrayToSort(resultIndex, column) = leftArray(leftLowest, column)
Next column
leftLowest = leftLowest + 1
resultIndex = resultIndex + IIf(Ascending, 1, -1)
Loop
Do While rightLowest <= rLength
For column = firstColumn To lastColumn
arrayToSort(resultIndex, column) = rightArray(rightLowest, column)
Next column
rightLowest = rightLowest + 1
resultIndex = resultIndex + IIf(Ascending, 1, -1)
Loop
End Sub
EDIT: Correct an error on filter 1D subroutine
