Note: Yes. It's big. I'm not expecting commensurately long/detailed answers (though if anyone wants to write one, you'll definitely be receiving a substantial bounty). This class is going to be useda lot in my VBA development soany reviews at all would be immensely helpful. Even if it's just a typo somewhere or an edge case that's not being checked or functionality you think should be added to it or even just a Gut-Check on coding smells, readability and the like.

If you want a paste-able version of this code, please seethis github repo

I do a lot of data analysis with spreadsheets. VBA has no in-built array functions (sorting, filtering etc.). This is a problem.

So, I took my accumulated collection of Array-manipulation methods, cleaned them up and turned them into a Class:CLS_2D_VarArray.

It is also supposed to be paired with my collection of Standard Methods, in aBase_Standard_Methods Module, and withCLS_Comparison_Predicate which is used to pass logical expressions to functions.

I would love to get peoples' thoughts on it.

Class-Level stuff:

Type of Array:
I only use 2-D Variant Arrays, declared thus:

Dim arr As VariantRedim arr(1 to 5, 1 to 5)

Only declared that way for various reasons which I won't go into here.
Only 2-Dimensional because that covers 95% of my use-cases, and supporting multi-dimensional operations would cause alot of additional complexity.

Properties:

Private Type TVarArray    varArray As Variant    ColumnHeaderIndexes As Dictionary '/ Set when SetArray is called with hasHeaders = True    PrintRange As Range '/ Set whenever Me.PrintToSheet is calledEnd TypePrivate This As TVarArray

Behaviour:
All the functions are designed to be chain-able. So, with the exception ofCopyArray(), which returns a copy ofVarArray, orGetArray(), which returnsVarArray itself, all functions return a newClass object.

E.G. I can do the following:

Set filteredArray = baseClass.RemoveIndexes().KeepHeaders().RemoveByPredicate()

This allows me to

• Never have to worry about over-writing the original Array/Data
• Perform operations in sequence without having to keep re-inserting array outputs into new class objects.

All inputs are checked/validated immediately upon calling a public method, before any business logic, and even if they will be checked again later on.

For now, failed validations justDebug.Print,MsgBox and thenStop because this is strictly for internal use, I'm the only developer and it's a lot more useful to me to justStop where the error is.

Most of the public methods validate inputs and then callInternal... methods for the actual operations.

Method List

SetArray,GetArray
CopyArray,CopyClass

CheckTargets
IsAllocated,GetBounds,IsListArray,SetColumnHeaderIndexes

InternalCopyArray
InternalCopyClass
InternalRemoveIndexes

InvertTargetIndexes

RemoveIndexes,KeepIndexes
RemoveByPredicate,KeepByPredicate
RemoveHeaders,KeepHeaders

ColumnIndexOfHeader
ArrayListFromIndex

AddData
MapHeadersToIndexes

InsertIndex,FillIndex

ReplaceValues

SortRows

PrintTosheet

External Methods/Classes included for context:

CLS_Comparison_Predicate
External Methods

Methods:

SetArray,GetArray

Not properties becauseSetArray needs to know if the array has headers or not, and propertyGet/Set/Lets can't have multiple arguments.

I had 2 options for headers. I could either assume that every array has headers, and ignore duplicate headers, or require a boolean declaration. I decided a declaration would be more annoying, but was preferable to ignoring duplicate-header collisions.

Public Sub SetArray(ByRef inputArray As Variant, Optional ByVal hasHeaders As Boolean = False)    If Not IsArray(inputArray) Then        PrintErrorMessage "Input is not an array"        Stop    Else        If Not DimensionCountOfArray(inputArray) = 2 Then            PrintErrorMessage "Input Array must be 2-dimensional"            Stop        Else            With This                .varArray = inputArray                If hasHeaders Then SetColumnHeaderIndexes Else Set .ColumnHeaderIndexes = Nothing            End With        End If    End IfEnd SubPublic Function GetArray() As Variant    GetArray = This.varArrayEnd Function

CopyArray,CopyClass

CopyArray also contains an argument for transposing the array.

Public Function CopyClass(Optional ByVal copyTransposed As Boolean = False) As CLS_2D_VarArray    Dim newClass As CLS_2D_VarArray    Set newClass = InternalCopyClass()    With newClass        If copyTransposed Then .ArrayObject = Transpose2dArray(.ArrayObject)    End With    Set CopyClass = newClassEnd FunctionPublic Function CopyArray(Optional ByVal copyTransposed As Boolean) As Variant    '/ Returns a new array object with identical contents to VarArray.    CopyArray = InternalCopyArray    If copyTransposed Then CopyArray = Transpose2dArray(CopyArray)End Function

CheckTargets

Which is a catch-all function for checking all possible inputs and should be called, in some form, from every public method (apart from the simple Get/Copy methods).

Private Function CheckTargets(Optional ByVal checkDimension As Variant, Optional ByVal checkIndex As Variant, Optional ByRef checkIndexList As Variant)    '/ Checks that VarArray is allocated    '/ If supplied, checks that target Dimension/Indexes exist    If Not IsAllocated Then        PrintErrorMessage "Array has not been allocated"        Stop    End If    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    If Not IsMissing(checkDimension) Then        If Not (checkDimension = 1 Or checkDimension = 2) Then            PrintErrorMessage "Target Dimension does not exist"            Stop        End If    End If    If Not IsMissing(checkIndex) Then        If Not ((checkDimension = 1 And checkIndex >= LB1 And checkIndex <= UB1) Or (checkDimension = 2 And checkIndex >= LB2 And checkIndex <= UB2)) Then            PrintErrorMessage "Target Index does not exist"            Stop        End If    End If    If Not IsMissing(checkIndexList) Then        If Not IsListArray(checkIndexList) <> 1 Then '/ Check that indexesToRemove is an arrayList            PrintErrorMessage "checkIndexList must be an arrayList"            Stop        End If        Dim listLB1 As Long, listUB1 As Long        listLB1 = LBound(checkIndexList)        listUB1 = UBound(checkIndexList)        Dim ix As Long        Dim testIndex As Long        For ix = listLB1 To listUB1            testIndex = checkIndexList(ix)            If Not ((checkDimension = 1 And testIndex >= LB1 And testIndex <= UB1) Or (checkDimension = 2 And testIndex >= LB2 And testIndex <= UB2)) Then                PrintErrorMessage "Target Index does not exist"                Stop            End If        Next ix    End IfEnd Function

IsAllocated,GetBounds,IsListArray,SetColumnHeaderIndexes

Simple utility functions.

Private Function IsAllocated() As Boolean    On Error GoTo CleanFail:    IsAllocated = IsArray(This.varArray) And Not IsError(LBound(This.varArray, 1)) And LBound(This.varArray, 1) <= UBound(This.varArray, 1)    On Error GoTo 0CleanExit:    Exit FunctionCleanFail:    On Error GoTo 0    IsAllocated = False    Resume CleanExitEnd FunctionPrivate Function IsListArray(ByRef checkVar As Variant) As Boolean    Dim passedChecks As Boolean    passedChecks = True    If Not IsArray(checkVar) Then        passedChecks = False        PrintErrorMessage "Input is not an array"        Stop    End If    If Not DimensionCountOfArray(checkVar) = 1 Then        passedChecks = False        PrintErrorMessage "Input Array must be 1-dimensional"        Stop    End If    IsListArray = passedChecksEnd FunctionPrivate Sub SetColumnHeaderIndexes()    Set This.ColumnHeaderIndexes = New Dictionary    Dim LB1 As Long, LB2 As Long, UB2 As Long    GetBounds LB1:=LB1, LB2:=LB2, UB2:=UB2    Dim header As Variant    Dim columnIndex As Long    Dim iy As Long    For iy = LB2 To UB2        columnIndex = iy        header = This.varArray(LB1, iy)        This.ColumnHeaderIndexes.item(header) = columnIndex    Next iyEnd Sub    Private Sub GetBounds( _    Optional ByRef LB1 As Variant, Optional ByRef UB1 As Variant, _    Optional ByRef LB2 As Variant, Optional ByRef UB2 As Variant)    '/ Assigns the L/U Bounds of the array for the specified dimension arguments    If Not IsMissing(LB1) Then LB1 = LBound(This.varArray, 1)    If Not IsMissing(UB1) Then UB1 = UBound(This.varArray, 1)    If Not IsMissing(LB2) Then LB2 = LBound(This.varArray, 2)    If Not IsMissing(UB2) Then UB2 = UBound(This.varArray, 2)End Sub

InternalCopyArray

This is the core internal function. Used for copying the array and removing indexes.

Private Function InternalCopyArray(Optional ByRef targetDimension As Variant, Optional ByRef indexesToIgnore As Variant) As Variant    '/ Returns a new array object with identical contents to This.VarArray.    '/ If target dimension & indexes are specified, will skip over them rather than copying, effectively removing them from the result.    CheckTargets targetDimension, checkIndexList:=indexesToIgnore    Dim targetsArePresent As Boolean    targetsArePresent = (Not IsMissing(targetDimension)) And (Not IsMissing(indexesToIgnore))    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    Dim newArray As Variant    If targetsArePresent Then        Select Case targetDimension            Case 1                ReDim newArray(LB1 To UB1 - DimLength(indexesToIgnore, 1), LB2 To UB2)            Case 2                ReDim newArray(LB1 To UB1, LB2 To UB2 - DimLength(indexesToIgnore, 1))        End Select    Else        ReDim newArray(LB1 To UB1, LB2 To UB2)    End If    Dim i As Long, j As Long    Dim ignoreCounter As Long    Dim ignoreIndex As Boolean    Dim copyElement As Variant    For i = LB1 To UB1        If targetsArePresent Then If targetDimension = 2 Then ignoreCounter = 0 '/ reset each row if targeting columns        For j = LB2 To UB2            If IsObject(This.varArray(i, j)) Then Set copyElement = This.varArray(i, j) Else copyElement = This.varArray(i, j)            If targetsArePresent Then                ignoreIndex = False                Select Case targetDimension                    Case 1                        ignoreIndex = Not IsNull(IndexIn1DArray(indexesToIgnore, i))                    Case 2                        ignoreIndex = Not IsNull(IndexIn1DArray(indexesToIgnore, j))                End Select                If ignoreIndex Then                    If targetDimension = 1 Then                        If j = LB2 Then ignoreCounter = ignoreCounter + 1 '/ only increment once per row if rows targeted                    Else                        ignoreCounter = ignoreCounter + 1                    End If                Else                    Select Case targetDimension                        Case 1                            If IsObject(copyElement) Then Set newArray(i - ignoreCounter, j) = copyElement Else newArray(i - ignoreCounter, j) = copyElement                        Case 2                            If IsObject(copyElement) Then Set newArray(i, j - ignoreCounter) = copyElement Else newArray(i, j - ignoreCounter) = copyElement                    End Select                End If            Else                If IsObject(copyElement) Then Set newArray(i, j) = copyElement Else newArray(i, j) = copyElement            End If        Next j    Next i    InternalCopyArray = newArrayEnd Function

InternalCopyClass

Used to produce the new Class Object outputs for each function.

Private Function InternalCopyClass(Optional ByRef inputArray As Variant) As CLS_2D_VarArray    CheckTargets    Dim newCopy As CLS_2D_VarArray    Set newCopy = New CLS_2D_VarArray    Dim withHeaders As Boolean    withHeaders = Not (This.ColumnHeaderIndexes Is Nothing)    If IsMissing(inputArray) Then        newCopy.SetArray Me.CopyArray(), withHeaders    Else        newCopy.SetArray inputArray, withHeaders    End If    Set newCopy.PrintRange = This.PrintRange    Set InternalCopyClass = newCopyEnd Function

InternalRemoveIndexes

Effectively an abstraction layer between input methods and the coreCopyArray function.

Private Function InternalRemoveIndexes(ByVal targetDimension As Long, ByRef indexesToRemove As Variant) As CLS_2D_VarArray    '/ Returns a new class object with identical array contents to This.VarArray.    '/ Will skip over target Indexes rather than copying, effectively removing them from the result.    Set InternalRemoveIndexes = InternalCopyClass(InternalCopyArray(targetDimension, indexesToRemove))End Function

InvertTargetIndexes

Given a list of indexes in a target dimension, returns a list of all theother indexes in that dimension. E.G. given a list of indexes to keep, invert the list and suddenly it's a list of indexes *not* to keep.

Whenever there is a Keep/Remove function, one will simply invert the target list and pass to the other.

Private Function InvertTargetIndexes(ByVal targetDimension As Long, ByRef targetIndexes As Variant) As Variant    '/ returns a listArray containing all the indexes NOT in targetIndexes.    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    Dim invertedIndexes As Variant    ReDim invertedIndexes(1 To DimLength(This.varArray, targetDimension) - DimLength(targetIndexes, 1))    Dim startIndex As Long, endIndex As Long    Select Case targetDimension        Case 1            startIndex = LB1            endIndex = UB1        Case 2            startIndex = LB2            endIndex = UB2    End Select    Dim matchCounter As Long    Dim ix As Long    For ix = startIndex To endIndex        If IsNull(IndexIn1DArray(targetIndexes, ix)) Then '/ is not in indexes to keep            matchCounter = matchCounter + 1            invertedIndexes(matchCounter) = ix        End If    Next ix    InvertTargetIndexes = invertedIndexesEnd Function

RemoveIndexes,KeepIndexes

Public Function RemoveIndexes(ByVal targetDimension As Long, ByRef indexesToRemove As Variant) As CLS_2D_VarArray    '/ Returns a new class object with identical array contents to VarArray.    '/ Will skip over target Indexes rather than copying, effectively removing them from the result.    If (Not IsMissing(targetDimension)) And (Not IsMissing(indexesToRemove)) Then        CheckTargets targetDimension, checkIndexList:=indexesToRemove        Set KeepIndexes = InternalRemoveIndexes(targetDimension, indexesToRemove)    Else        PrintErrorMessage "Both target Dimension and target Indexes must be supplied"        Stop    End IfEnd FunctionPublic Function KeepIndexes(ByVal targetDimension As Long, ByRef indexesToKeep As Variant) As CLS_2D_VarArray    '/ Returns a new class object with identical array contents to VarArray.    '/ Will skip over non-target Indexes rather than copying, effectively removing them from the result.    If (Not IsMissing(targetDimension)) And (Not IsMissing(indexesToKeep)) Then        CheckTargets targetDimension, checkIndexList:=indexesToKeep        Set KeepIndexes = InternalRemoveIndexes(targetDimension, InvertTargetIndexes(indexesToKeep))    Else        PrintErrorMessage "Both target Dimension and target Indexes must be supplied"        Stop    End IfEnd Function

RemoveByPredicate,KeepByPredicate

Filter the array, based on values in a target index, using a logical predicate.

Public Function RemoveByPredicate(ByVal targetDimension As Long, ByVal targetIndex As Long, ByRef predicate As CLS_Comparison_Predicate) As CLS_2D_VarArray    '/ Use the predicate to build a list of indexes to remove, then pass to InternalRemoveIndexes    '/ E.G. dimension 2, index 1, predicate(GreaterThan, 9000) will remove all rows where the value in column 1 is Greater Than 9,000    If predicate Is Nothing Then        PrintErrorMessage "Predicate must be set"        Stop    End If    CheckTargets targetDimension, targetIndex    Dim arrayListAtIndex As Variant    arrayListAtIndex = ArrayListFromIndex(targetDimension, targetIndex)    Dim LB1 As Long, UB1 As Long    AssignArrayBounds arrayListAtIndex, LB1, UB1    Dim removeCounter As Long    Dim indexesToRemove As Variant    ReDim indexesToRemove(1 To 1)    Dim ix As Long    For ix = LB1 To UB1        If predicate.Compare(arrayListAtIndex(ix)) Then            removeCounter = removeCounter + 1            ReDim Preserve indexesToRemove(1 To removeCounter)            indexesToRemove(removeCounter) = ix        End If    Next ix    If removeCounter > 0 Then        '/ Target Dimension for removal will be the opposite to the one we were comparing        Select Case targetDimension            Case 1                targetDimension = 2            Case 2                targetDimension = 1        End Select        Set RemoveByPredicate = InternalRemoveIndexes(targetDimension, indexesToRemove)    Else        Set RemoveByPredicate = InternalCopyClass    End IfEnd FunctionPublic Function KeepByPredicate(ByVal targetDimension As Long, ByVal targetIndex As Long, ByRef predicate As CLS_Comparison_Predicate) As CLS_2D_VarArray    '/ Inverts the predicate, then passes to RemoveByPredicate    If predicate Is Nothing Then        PrintErrorMessage "Predicate must be set"        Stop    End If    CheckTargets targetDimension, targetIndex    Dim invertedPredicate As CLS_Comparison_Predicate    Set invertedPredicate = predicate.Copy(copyInverted:=True)    Set KeepByPredicate = Me.RemoveByPredicate(targetDimension, targetIndex, invertedPredicate)End Function

RemoveHeaders,KeepHeaders

Public Function RemoveHeaders(ByVal headerList As Variant) As CLS_2D_VarArray    '/ Use the headers to build a list of indexes to remove, then pass to InternalRemoveIndexes    If Not IsListArray(headerList) Then        PrintErrorMessage "headerList must be a listArray"        Stop    End If    Const TARGET_DIMENSION As Long = 2 '/ Targeting columns    Dim indexesOfHeaders As Variant    indexesOfHeaders = GetIndexesOfHeaders(headerList)    Set KeepHeaders = InternalRemoveIndexes(TARGET_DIMENSION, indexesOfHeaders)End FunctionPublic Function KeepHeaders(ByVal headerList As Variant) As CLS_2D_VarArray    '/ Use the headers to build a list of indexes to remove, then pass to InternalRemoveIndexes    If Not IsListArray(headerList) Then        PrintErrorMessage "headerList must be a listArray"        Stop    End If    Const TARGET_DIMENSION As Long = 2 '/ Targeting columns    Dim indexesOfHeaders As Variant    indexesOfHeaders = GetIndexesOfHeaders(headerList)    Set KeepHeaders = InternalRemoveIndexes(TARGET_DIMENSION, InvertTargetIndexes(2, indexesOfHeaders))End Function

ColumnIndexOfHeader

Public Function ColumnIndexOfHeader(ByVal header As Variant) As Variant    '/ Returns NULL if header cannot be found in ColumnHeaderIndexes    With This        If .ColumnHeaderIndexes.Exists(header) Then ColumnIndexOfHeader = .ColumnHeaderIndexes.item(header) Else ColumnIndexOfHeader = Null    End WithEnd Function

ArrayListFromIndex

Public Function ArrayListFromIndex(ByVal targetDimension As Long, ByVal targetIndex As Long) As Variant    '/ Given a target index in VarArray, return a 1-D array of all the items in that index.    '/ The returned array will still retain the same indexes as the original    CheckTargets targetDimension, targetIndex    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    Dim arrayList As Variant    Dim i As Long    Select Case targetDimension        Case 1            ReDim arrayList(LB2 To UB2)            For i = LB2 To UB2                If IsObject(This.varArray(targetIndex, i)) Then Set arrayList(i) = This.varArray(targetIndex, i) Else arrayList(i) = This.varArray(targetIndex, i)            Next i        Case 2            ReDim arrayList(LB1 To UB1)            For i = LB1 To UB1                If IsObject(This.varArray(i, targetIndex)) Then Set arrayList(i) = This.varArray(i, targetIndex) Else arrayList(i) = This.varArray(i, targetIndex)            Next i    End Select    ArrayListFromIndex = arrayListEnd Function

AddData

Given some input array, find the corresponding headers inVarArray and copy the contents to new rows.

Public Sub AddData(ByRef inputArray As CLS_2D_VarArray)    '/ Takes the input array, determines that all headers exist in this array then writes all data to newlines    CheckTargets    If This.ColumnHeaderIndexes Is Nothing Then        PrintErrorMessage "Cannot match data as VarArray has no headers"        Stop    End If    Dim inputData As Variant    inputData = inputArray.GetArray    If IsEmpty(inputData) Then        PrintErrorMessage "Input array has no data"        Stop    End If    Dim mapHeaders As Dictionary    Set mapHeaders = MapHeadersToIndexes(inputData)    Dim inputLB1 As Long, inputUB1 As Long    Dim inputLB2 As Long, inputUB2 As Long    AssignArrayBounds inputData, inputLB1, inputUB1, inputLB2, inputUB2    Dim thisLB1 As Long, thisUB1 As Long    Dim thisLB2 As Long, thisUB2 As Long    GetBounds thisLB1, thisUB1, thisLB2, thisUB2    Dim thisArray As Variant    thisArray = This.varArray    thisArray = Transpose2dArray(thisArray)    ReDim Preserve thisArray(thisLB2 To thisUB2, thisLB1 To thisUB1 + (DimLength(inputData, 1) - 1)) '/ -1 because not copying header row    thisArray = Transpose2dArray(thisArray)    Dim header As Variant    Dim columnIndex As Long    Dim copyElement As Variant    Dim ix As Long, iy As Long '/ inputData indexes    Dim thisRow As Long, thisCol As Long '/ thisArray indexes    For iy = inputLB2 To inputUB2        header = inputData(inputLB1, iy)        columnIndex = mapHeaders(header)        thisCol = columnIndex        For ix = inputLB1 + 1 To inputUB1 '/ +1 for ignoring headers            thisRow = thisUB1 + (ix - (inputLB1 + 1) + 1)            If IsObject(inputData(ix, iy)) Then Set thisArray(thisRow, thisCol) = inputData(ix, iy) Else thisArray(thisRow, thisCol) = inputData(ix, iy)        Next ix    Next iy    Me.SetArray (thisArray)End Sub

MapHeadersToIndexes

Used to map headers forAddData

Private Function MapHeadersToIndexes(ByRef inputData As Variant) As Dictionary    '/ For each header in inputData, finds the matching header in VarArray, adds the header/index to a dictionary    '/ Throws an error if a header cannot be matched to VarArray    Dim LB1 As Long    Dim LB2 As Long, UB2 As Long    AssignArrayBounds inputData, LB1, LB2:=LB2, UB2:=UB2    Dim mapHeaders As Dictionary    Set mapHeaders = New Dictionary    Dim header As Variant    Dim columnIndex As Long    Dim iy As Long    For iy = LB2 To UB2        header = inputData(LB1, iy)        If This.ColumnHeaderIndexes.Exists(header) Then            columnIndex = This.ColumnHeaderIndexes.item(header)            mapHeaders.Add header, columnIndex        Else            PrintErrorMessage "Header "" & cstr(header) & "" does not exist in this array"            Stop        End If    Next iy    Set MapHeadersToIndexes = mapHeadersEnd Function

InsertIndex,FillIndex

Public Function InsertIndex(ByVal targetDimension As Long, ByVal targetIndex As Long, Optional ByVal header As Variant, Optional ByVal fillValue As Variant) As CLS_2D_VarArray    '/ Returns a copy of VarArray with a new Row/Column by copying VarArray and leaving an extra gap at the specified index.    CheckTargets targetDimension, targetIndex    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    Dim newArr As Variant    If targetDimension = 1 Then ReDim newArr(LB1 To UB1 + 1, LB2 To UB2)    If targetDimension = 2 Then ReDim newArr(LB1 To UB1, LB2 To UB2 + 1)    Dim isAfterTarget As Boolean    Dim sourceValue As Variant    Dim ix As Long, iy As Long    For ix = LB1 To UB1        For iy = LB2 To UB2            sourceValue = This.varArray(ix, iy)            isAfterTarget = targetDimension = 1 And ix >= targetIndex Or targetDimension = 2 And iy >= targetIndex            If isAfterTarget Then                If targetDimension = 1 Then If IsObject(sourceValue) Then Set newArr(ix + 1, iy) = sourceValue Else newArr(ix + 1, iy) = sourceValue                If targetDimension = 2 Then If IsObject(sourceValue) Then Set newArr(ix, iy + 1) = sourceValue Else newArr(ix, iy + 1) = sourceValue            Else                If IsObject(sourceValue) Then Set newArr(ix, iy) = sourceValue Else newArr(ix, iy) = sourceValue            End If        Next iy    Next ix    If Not (IsMissing(fillValue) And IsMissing(header)) Then FillIndex2D newArr, targetDimension, targetIndex, fillValue, header    Set InsertIndex = InternalCopyClass(newArr)End FunctionPublic Function FillIndex(ByVal targetDimension As Long, ByVal targetIndex As Long, Optional ByVal fillValue As Variant, Optional ByVal header As Variant) As CLS_2D_VarArray    '/ Fills every element of the index with fill value. If header is provided then the lower-bound of the index will contain the header value.    CheckTargets targetDimension, targetIndex    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    Dim newArray As Variant    newArray = InternalCopyArray    Dim ix As Long, iy As Long    Select Case targetDimension        Case 1            If Not IsMissing(fillValue) Then                For iy = LB2 To UB2                    newArray(targetIndex, iy) = fillValue                Next iy            End If            If Not IsMissing(header) Then This.varArray(targetIndex, LB2) = header        Case 2            If Not IsMissing(fillValue) Then                For ix = LB1 To UB1                    newArray(ix, targetIndex) = fillValue                Next ix            End If            If Not IsMissing(header) Then This.varArray(LB1, targetIndex) = header    End Select    Set FillIndex = InternalCopyClass(newArray)End Function

ReplaceValues

Public Function ReplaceValues(ByVal findValue As Variant, ByVal replaceValue As Variant) As CLS_2D_VarArray    '/ Replaces all *exact* occurences of the find value with the replace value. *exact* means the entirety of the array element must match.    '/ Ignores objects.    CheckTargets    Dim newArray As Variant    newArray = InternalCopyArray    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    Dim i As Long, j As Long    For i = LB1 To UB1        For j = LB2 To UB2            If Not IsObject(newArray(i, j)) Then If newArray(i, j) = findValue Then newArray(i, j) = replaceValue        Next j    Next i    Set ReplaceValues = InternalCopyClass(newArray)End Function

SortRows

Public Function SortRows(ByVal sortIndex As Long, Optional ByVal ignoreHeaders As Boolean = True, Optional ByVal sortOrder As XlSortOrder = xlAscending) As CLS_2D_VarArray    '/ Simple Bubble sort - *Towards* the upper bound of the index - so xlAscending will result in the largest value being at the upper-bound of the index    '/ Will fail if the index contains objects    Const TARGET_DIMENSION As Long = 2 '/ sorting rows IN a column    CheckTargets checkIndex:=sortIndex    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    GetBounds LB1, UB1, LB2, UB2    If ignoreHeaders Then LB1 = LB1 + 1    Dim newArray As Variant    newArray = InternalCopyArray    Dim numIterations As Long    numIterations = DimLength(newArray, 1) - 1    If ignoreHeaders Then numIterations = numIterations - 1    Dim swapValues As Boolean    Dim currentItem As Variant, nextItem As Variant    Dim currentIndex As Long, nextIndex As Long    Dim ix As Long, iy As Long    For ix = 1 To numIterations        For currentIndex = LB1 To UB1 - 1            nextIndex = currentIndex + 1            currentItem = newArray(currentIndex, sortIndex)            nextItem = newArray(nextIndex, sortIndex)            swapValues = False            If sortOrder = xlAscending Then                swapValues = currentItem > nextItem            Else                swapValues = currentItem < nextItem            End If            If swapValues Then                For iy = LB2 To UB2                    '/ Sort column must have values, but the rest of the array could easily contain objects as well                    If IsObject(newArray(currentIndex, iy)) Then Set currentItem = newArray(currentIndex, iy) Else currentItem = newArray(currentIndex, iy)                    If IsObject(newArray(nextIndex, iy)) Then Set nextItem = newArray(nextIndex, iy) Else nextItem = newArray(nextIndex, iy)                    If IsObject(currentItem) Then Set newArray(nextIndex, iy) = currentItem Else newArray(nextIndex, iy) = currentItem                    If IsObject(nextItem) Then Set newArray(currentIndex, iy) = nextItem Else newArray(currentIndex, iy) = nextItem                Next iy            End If        Next currentIndex    Next ix    Set SortRows = InternalCopyClass(newArray)End Function

PrintToSheet

Public Sub PrintToSheet(ByRef targetSheet As Worksheet, Optional ByRef startCell As Range)    CheckTargets    If startCell Is Nothing Then Set startCell = targetSheet.Cells(1, 1)    Dim rowCount As Long, colCount As Long    rowCount = DimLength(This.varArray, 1)    colCount = DimLength(This.varArray, 2)    Dim PrintRange As Range    With targetSheet        Set PrintRange = .Range(startCell, .Cells(startCell.row + rowCount - 1, startCell.Column + colCount - 1))    End With    PrintRange = This.varArray    Set This.PrintRange = PrintRangeEnd Sub

External Methods/Classes included for context:

CLS_Comparison_Predicate

Option ExplicitPrivate Type TComparer    Operator As ComparisonOperator    RightValue As VariantEnd TypePrivate This As TComparerPrivate Const NULL_ERROR_TEXT As String = "Invalid Compare input. Cannot compare against Null"Private Const OBJECT_ERROR_TEXT As String = "Invalid Compare input. Input must be a value, not an object"Private Const EMPTY_ERROR_TEXT As String = "Invalid Compare Input. Input cannot be empty"Private Const ZLS_ERROR_TEXT As String = "Invalid Compare Input. Input cannot be a Zero-Length-String"Public Property Let Operator(ByVal inputOperator As ComparisonOperator)    This.Operator = inputOperatorEnd PropertyPublic Property Let RightValue(ByVal inputValue As Variant)    CheckInputValue inputValue    This.RightValue = inputValueEnd PropertyPublic Function Copy(Optional ByVal copyInverted As Boolean = False) As CLS_Comparison_Predicate    Dim newPredicate As CLS_Comparison_Predicate    Set newPredicate = New CLS_Comparison_Predicate    With newPredicate        .RightValue = This.RightValue        If Not copyInverted Then            .Operator = This.Operator        Else            Select Case This.Operator                Case NotEqualTo                    .Operator = EqualTo                Case LessThan                    .Operator = GreaterThanOrEqualTo                Case LessThanOrEqualTo                    .Operator = GreaterThan                Case EqualTo                    .Operator = NotEqualTo                Case GreaterThanOrEqualTo                    .Operator = LessThan                Case GreaterThan                    .Operator = LessThanOrEqualTo                Case Else                    '/ Should only happen if operator has not been set                    PrintErrorMessage "operator has not been set"                    Stop            End Select        End If    End With    Set Copy = newPredicateEnd FunctionPublic Function Compare(ByVal inputValue As Variant) As Boolean    CheckInputValue inputValue    With This        Dim isTrue As Boolean        Select Case .Operator            Case NotEqualTo                isTrue = (inputValue <> .RightValue)            Case LessThan                isTrue = (inputValue < .RightValue)            Case LessThanOrEqualTo                isTrue = (inputValue <= .RightValue)            Case EqualTo                isTrue = (inputValue = .RightValue)            Case GreaterThanOrEqualTo                isTrue = (inputValue >= .RightValue)            Case GreaterThan                isTrue = (inputValue > .RightValue)            Case Else                '/ Should only happen if operator has not been set                PrintErrorMessage "operator has not been set"                Stop        End Select    End With    Compare = isTrueEnd FunctionPrivate Sub CheckInputValue(ByVal inputValue As Variant)    '/ Check for NULL, Objects, Empty and ZLS    If IsNull(inputValue) Then        PrintErrorMessage NULL_ERROR_TEXT        Stop    End If    If IsObject(inputValue) Then        PrintErrorMessage OBJECT_ERROR_TEXT        Stop    End If    If IsEmpty(inputValue) Then        PrintErrorMessage EMPTY_ERROR_TEXT        Stop    End If    On Error Resume Next        If Len(inputValue) = 0 Then            PrintErrorMessage ZLS_ERROR_TEXT            Stop        End If    On Error GoTo 0End Sub

External Methods

Public Sub AssignArrayBounds(ByRef targetArray As Variant, _    Optional ByRef LB1 As Variant, Optional ByRef UB1 As Variant, _    Optional ByRef LB2 As Variant, Optional ByRef UB2 As Variant, _    Optional ByRef LB3 As Variant, Optional ByRef UB3 As Variant, _    Optional ByRef LB4 As Variant, Optional ByRef UB4 As Variant, _    Optional ByRef LB5 As Variant, Optional ByRef UB5 As Variant)    '/ Assigns the L/U Bounds of the array for the specified dimension arguments    If Not IsMissing(LB1) Then LB1 = LBound(targetArray, 1)    If Not IsMissing(UB1) Then UB1 = UBound(targetArray, 1)    If Not IsMissing(LB2) Then LB2 = LBound(targetArray, 2)    If Not IsMissing(UB2) Then UB2 = UBound(targetArray, 2)    If Not IsMissing(LB3) Then LB3 = LBound(targetArray, 3)    If Not IsMissing(UB3) Then UB3 = UBound(targetArray, 3)    If Not IsMissing(LB4) Then LB4 = LBound(targetArray, 4)    If Not IsMissing(UB4) Then UB4 = UBound(targetArray, 4)    If Not IsMissing(LB5) Then LB5 = LBound(targetArray, 5)    If Not IsMissing(UB5) Then UB5 = UBound(targetArray, 5)End SubPublic Function DimensionCountOfArray(ByRef targetArray As Variant)    Dim maxDimension As Long    Dim errCheck As Variant    maxDimension = 0    Do While maxDimension <= 60000        On Error GoTo maxFound            errCheck = LBound(targetArray, maxDimension + 1)        On Error GoTo 0        maxDimension = maxDimension + 1    LoopmaxFound:    On Error GoTo 0    DimensionCountOfArray = maxDimensionEnd FunctionPublic Function IndexIn1DArray(ByRef targetArray As Variant, ByVal searchItem As Variant, Optional ByVal startAtLowerBound As Boolean = True, Optional ByVal nthMatch As Long = 1, Optional ByRef matchWasFound As Boolean) As Variant    '/ Returns the index of the Nth Match of a value in the target array. Returns Null if match not found.    Dim LB1 As Long, UB1 As Long    AssignArrayBounds targetArray, LB1, UB1    Dim startIndex As Long, endIndex As Long, stepValue As Long    If startAtLowerBound Then        startIndex = LB1        endIndex = UB1        stepValue = 1    Else        startIndex = UB1        endIndex = LB1        stepValue = -1    End If    Dim matchCounter As Long    matchCounter = 0    Dim targetIndex As Variant    targetIndex = Null    Dim i As Long    For i = startIndex To endIndex Step stepValue        If targetArray(i) = searchItem Then matchCounter = matchCounter + 1        If matchCounter = nthMatch Then            targetIndex = i            Exit For        End If    Next i    If Not IsNull(targetIndex) Then targetIndex = CLng(targetIndex)    IndexIn1DArray = targetIndexEnd FunctionPublic Function Transpose2dArray(ByRef sourceArray As Variant) As Variant    Dim LB1 As Long, UB1 As Long    Dim LB2 As Long, UB2 As Long    AssignArrayBounds sourceArray, LB1, UB1, LB2, UB2    Dim transposedArray() As Variant    ReDim transposedArray(LB2 To UB2, LB1 To UB1)    Dim i As Long, j As Long    For i = LB1 To UB1        For j = LB2 To UB2            transposedArray(j, i) = sourceArray(i, j)        Next j    Next i    Transpose2dArray = transposedArrayEnd Function

• 3
  \$\begingroup\$Itis possible to haveproperties with multiple args, but just because you can, doesn't mean you should. So, I'd say using a method was the right call.\$\endgroup\$

  RubberDuck

  – RubberDuck

  2016-05-23 15:47:36 +00:00

  CommentedMay 23, 2016 at 15:47
• \$\begingroup\$Any particular reason you're doingif then else on single lines?\$\endgroup\$

  Raystafarian

  – Raystafarian

  2016-05-24 13:33:41 +00:00

  CommentedMay 24, 2016 at 13:33
• \$\begingroup\$In general, because I felt it made the function/code more readable. Especially when it's for things like object-checking.\$\endgroup\$

  Kaz

  – Kaz

  2016-05-24 13:50:25 +00:00

  CommentedMay 24, 2016 at 13:50

1 Answer1

Start asking to get answers

Find the answer to your question by asking.

Explore related questions

See similar questions with these tags.