Filter a two dimension array

Question

This is the function I've wrote to filter a two-dimension array. I use it mainly on forms with user-defined filter (categories, dates, search bar, etc). It works fine, but it's ugly. Do you have any advice?

Function FilterArray(ByVal originalArray As Variant, _
                    Optional arrayOfColumnToReturn As Variant, _
                    Optional firstExactMatchColumn As Integer = -1, Optional firstExactMatchValue As Variant, _
                    Optional secondExactMatchColumn As Integer = -1, Optional secondExactMatchValue As Variant, _
                    Optional thirdExactMatchColumn As Integer = -1, Optional thirdExactMatchValue As Variant, _
                    Optional firstColumnToExclude As Integer = -1, Optional firstValueToExclude As Variant, _
                    Optional secondColumnToExclude As Integer = -1, Optional secondValueToExclude As Variant, _
                    Optional thirdColumnToExclude As Integer = -1, Optional thirdValueToExclude As Variant, _
                    Optional firstColumnIsBetween As Integer = -1, Optional firstLowValue As Variant, Optional firstHighValue As Variant, _
                    Optional secondColumnIsBetween As Integer = -1, Optional secondLowValue As Variant, Optional secondHighValue As Variant, _
                    Optional thirdColumnIsBetween As Integer = -1, Optional thirdLowValue As Variant, Optional thirdHighValue As Variant, _
                    Optional partialMatchColumnsArray As Variant = -1, Optional partialMatchValue As Variant) As Variant

    FilterArray = -1

    If Not IsArray(originalArray) Then Exit Function

    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 filteredArrayRow    As Long
    Dim partialCol          As Long

    firstRow = LBound(originalArray, 1)
    lastRow = UBound(originalArray, 1)
    firstColumn = LBound(arrayOfColumnToReturn)
    lastColumn = UBound(arrayOfColumnToReturn)

    ' If the caller don't pass the array of column to return I create an array with all the columns and I 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 spacial value 1, if true the partial macth will be performed on values in columns to return
    If Not IsArray(partialMatchColumnsArray) Then
        If partialMatchColumnsArray = 1 Then partialMatchColumnsArray = arrayOfColumnToReturn
    End If

    ReDim tempFilteredArray(firstColumn To lastColumn, firstRow To firstRow) As Variant

    filteredArrayRow = firstRow - 1

    For row = firstRow To lastRow

        ' Start Exact Match check
        If firstExactMatchColumn > -1 Then
            If LCase(originalArray(row, firstExactMatchColumn)) <> LCase(firstExactMatchValue) Then GoTo SkipRow
        End If
        If secondExactMatchColumn > -1 Then
            If LCase(originalArray(row, secondExactMatchColumn)) <> LCase(secondExactMatchValue) Then GoTo SkipRow
        End If
        If thirdExactMatchColumn > -1 Then
            If LCase(originalArray(row, thirdExactMatchColumn)) <> LCase(thirdExactMatchValue) Then GoTo SkipRow
        End If
        ' End Exact Match check

        ' Start Negative Match check
        If firstColumnToExclude > -1 Then
            If LCase(originalArray(row, firstColumnToExclude)) = LCase(firstValueToExclude) Then GoTo SkipRow
        End If
        If secondColumnToExclude > -1 Then
            If LCase(originalArray(row, secondColumnToExclude)) = LCase(secondValueToExclude) Then GoTo SkipRow
        End If
        If thirdColumnToExclude > -1 Then
            If LCase(originalArray(row, thirdColumnToExclude)) = LCase(thirdValueToExclude) Then GoTo SkipRow
        End If
        ' End Negative Match check

        ' Start isBetween check
        If firstColumnIsBetween > -1 Then
            If originalArray(row, firstColumnIsBetween) < firstLowValue Or originalArray(row, firstColumnIsBetween) > firstHighValue Then GoTo SkipRow
        End If
        If secondColumnIsBetween > -1 Then
            If originalArray(row, secondColumnIsBetween) < secondLowValue Or originalArray(row, secondColumnIsBetween) > secondHighValue Then GoTo SkipRow
        End If
        If thirdColumnIsBetween > -1 Then
            If originalArray(row, thirdColumnIsBetween) < thirdLowValue Or originalArray(row, thirdColumnIsBetween) < thirdHighValue Then GoTo SkipRow
        End If
        ' End isBetween check

        ' Start partial match check
        If IsArray(partialMatchColumnsArray) Then
            For partialCol = LBound(partialMatchColumnsArray) To UBound(partialMatchColumnsArray)
                If InStr(1, originalArray(row, partialMatchColumnsArray(partialCol)), partialMatchValue, vbTextCompare) > 0 Then
                    GoTo WriteRow
                End If
            Next partialCol
            GoTo SkipRow
        End If
        ' End partial match check
WriteRow:
        ' Writing data in the filtered array
        filteredArrayRow = filteredArrayRow + 1
        ReDim Preserve tempFilteredArray(firstColumn To lastColumn, firstRow To filteredArrayRow) As Variant

        For col = firstColumn To lastColumn
            tempFilteredArray(col, filteredArrayRow) = originalArray(row, arrayOfColumnToReturn(col))
        Next col
SkipRow:
    Next row

    If filteredArrayRow > firstRow - 1 Then
        FilterArray = Application.Transpose(tempFilteredArray)
    End If

    Erase originalArray
    Erase arrayOfColumnToReturn
    If IsArray(partialMatchColumnsArray) Then Erase partialMatchColumnsArray
    If IsArray(tempFilteredArray) Then Erase tempFilteredArray

End Function

Answer 1

I have two solutions for your problem. The first is how I would have tackled the problem before I found the free and fantastic RubberDuck addin for VBA and read all of the really helpful and informative blog articles on OOP.

The second is an OOP solution which allowed me to have some nice fun (on a wet a dismal winter afternoon) with the OOP learnings I've gained from the RubberDuck community. I'll put the OOP solution in a second answer if I have the time.

I suspect that you do not use Option Explicit at the start of your modules as there are undeclared variables in your code. I'd strongly recommend putting Option Explicit at the start of every Module and Class.

Generally your code is quite good in the sense that you have used informative names and have modularised actions. This meant it was pretty easy to refactor.

The issue that is preventing you simplifying your code is that you have a lot of dependencies within the function so moving 'modules' to separate activities would involve a lot of parameter passing, and multiple returns.

A bad point is that you have some gnarly gotos which does obscure what is going on even though I can see the logic behind why you have used gotos in the way you have. Gotos are not necessarily bad but it is always better if we can replace naked gotos with structured gotos (i.e. exit for, exit function etc).

To remove dependencies within the function you need to move from 'Operating with' to 'Operating On'. To do this you need to move the parameters and internal variables to outside of the function. The safest and most helpful way of doing this is to capture the parameters and variables in their own UDTs which will be at module scope and which, because they are encapsulated in a Type variable, will not interfere with any other code you have.

This was done by creating the UDTs called FilterParameters and FilterState their respective module level variables of p and s respectively (to minimise typing). I then went through and renamed everything inside the function so that it was prefixed with either p. or s. as appropriate. Some variables were not needed in the State UDT because they were essentially local to the 'module'.

It was then very simple to break down your function into a number of smaller subs and functions.

The refactored code is below.

Option Explicit

Private Type FilterParameters

    originalArray                               As Variant
    arrayOfColumnToReturn                       As Variant
    firstExactMatchColumn                       As Long
    firstExactMatchValue                        As Variant
    secondExactMatchColumn                      As Long
    secondExactMatchValue                       As Variant
    thirdExactMatchColumn                       As Long
    thirdExactMatchValue                        As Variant
    firstColumnToExclude                        As Long
    firstValueToExclude                         As Variant
    secondColumnToExclude                       As Long
    secondValueToExclude                        As Variant
    thirdColumnToExclude                        As Long
    thirdValueToExclude                         As Variant
    firstColumnIsBetween                        As Long
    firstLowValue                               As Variant
    firstHighValue                              As Variant
    secondColumnIsBetween                       As Long
    secondLowValue                              As Variant
    secondHighValue                             As Variant
    thirdColumnIsBetween                        As Long
    thirdLowValue                               As Variant
    thirdHighValue                              As Variant
    partialMatchColumnsArray                    As Variant
    partialMatchValue                           As Variant

End Type

Private p                                       As FilterParameters


Private Type FilterState

    ' Items here are used in multiple methods.
    ' otherwise the state member was demoted to a local variabel
    firstRow                                    As Long
    lastRow                                     As Long
    firstColumn                                 As Long
    lastColumn                                  As Long
    filteredArrayRow                            As Long
    tempFilteredArray                           As Variant

End Type

Private s                                       As FilterState

Public Sub SetupFilterParameters()

    ' replace your_value with a value or comment out the line to prevent
    ' compile errors for an undeclared variable.
    With p

        .originalArray = your_value
        .arrayOfColumnToReturn = your_value

        .firstExactMatchColumn = -1
        .firstExactMatchValue = your_value
        .secondExactMatchColumn = -1
        .secondExactMatchValue = your_value
        .thirdExactMatchColumn = -1
        .thirdExactMatchValue = your_value

        .firstColumnToExclude = -1
        .firstValueToExclude = your_value
        .secondColumnToExclude = -1
        .secondValueToExclude = your_value
        .thirdColumnToExclude = -1
        .thirdValueToExclude = your_value

        .firstColumnIsBetween = -1
        .firstLowValue = your_value
        .firstHighValue = your_value
        .secondColumnIsBetween = -1
        .secondLowValue = your_value
        .secondHighValue = your_value
        .thirdColumnIsBetween = -1
        .thirdLowValue = your_value
        .thirdHighValue = your_value

        .partialMatchColumnsArray = your_value
        .partialMatchValue = your_value

    End With

End Sub

Public Function FilterArray() As Variant

    FilterArray = -1

    If Not IsArray(p.originalArray) Then Exit Function

    s.firstRow = LBound(p.originalArray, 1)
    s.lastRow = UBound(p.originalArray, 1)
    s.firstColumn = LBound(p.arrayOfColumnToReturn)
    s.lastColumn = UBound(p.arrayOfColumnToReturn)

    InitialiseReturnColumns
    InitialisePartialCheck

    ReDim s.tempFilteredArray(s.firstColumn To s.lastColumn, s.firstRow To s.firstRow) As Variant
    s.filteredArrayRow = s.firstRow - 1

    Dim myRow As Long
    For myRow = s.firstRow To s.lastRow

        WriteRow myRow

    Next

    ' This nextaction seems incomplete as at this point FilterArray is still -1
    ' so we might expect to see an else clause in the test below
    ' where an untransposed array is passed to FilterArray.
    If s.filteredArrayRow > s.firstRow - 1 Then
        FilterArray = Application.WorksheetFunction.Transpose(s.tempFilteredArray)
    End If

    p.originalArray = Empty
    p.arrayOfColumnToReturn = Empty
    If IsArray(p.partialMatchColumnsArray) Then p.partialMatchColumnsArray = Empty
    If IsArray(s.tempFilteredArray) Then s.tempFilteredArray = Empty

End Function

Public Sub InitialisePartialCheck()
    ' If the caller don't pass an array for partial match check if it pass the spacial value 1,
    ' if true the partial macth will be performed on values in columns to return
    If Not IsArray(p.partialMatchColumnsArray) Then

        If p.partialMatchColumnsArray = 1 Then p.partialMatchColumnsArray = p.arrayOfColumnToReturn

    End If

End Sub

Public Sub InitialiseReturnColumns()

    ' If the caller don't pass the array of column to return
    ' I create an array with all the columns and I preserve the order
    If Not IsArray(p.arrayOfColumnToReturn) Then

        ReDim p.arrayOfColumnToReturn(LBound(p.originalArray, 2) To UBound(p.originalArray, 2))

        Dim col As Long
        For col = LBound(p.originalArray, 2) To UBound(p.originalArray, 2)

            p.arrayOfColumnToReturn(col) = col

        Next col

    End If

End Sub

Public Sub WriteRow(ByVal ipRow As Long)

    If Not RowValidates(ipRow) Then Exit Sub
    ' Start partial match check
    If IsArray(p.partialMatchColumnsArray) Then

        Dim partialCol As Long
        For partialCol = LBound(p.partialMatchColumnsArray) To UBound(p.partialMatchColumnsArray)

            If InStr(1, p.originalArray(ipRow, p.partialMatchColumnsArray(partialCol)), p.partialMatchValue, vbTextCompare) > 0 Then

                WriteFilteredArrayRow ipRow
                Exit Sub                         ' Was goto SkipRow

            End If

        Next

    End If
    ' End partial match check

End Sub

Public Sub WriteFilteredArrayRow(ByVal ipRow As Long)

    ' WriteRow:
    ' Writing data in the filtered array
    s.filteredArrayRow = s.filteredArrayRow + 1
    ReDim Preserve s.tempFilteredArray(s.firstColumn To s.lastColumn, s.firstRow To s.filteredArrayRow) As Variant

    Dim myCol As Long
    For myCol = s.firstColumn To s.lastColumn

        s.tempFilteredArray(myCol, s.filteredArrayRow) = p.originalArray(ipRow, p.arrayOfColumnToReturn(myCol))

    Next

End Sub

Public Function RowValidates(ByVal ipRow As Long) As Boolean
    ' Start Exact Match check
    RowValidates = False
    If p.firstExactMatchColumn > -1 Then
        If LCase$(p.originalArray(ipRow, p.firstExactMatchColumn)) <> LCase$(p.firstExactMatchValue) Then Exit Function
    End If
    If p.secondExactMatchColumn > -1 Then
        If LCase$(p.originalArray(ipRow, p.secondExactMatchColumn)) <> LCase$(p.secondExactMatchValue) Then Exit Function
    End If
    If p.thirdExactMatchColumn > -1 Then
        If LCase$(p.originalArray(ipRow, p.thirdExactMatchColumn)) <> LCase$(p.thirdExactMatchValue) Then Exit Function
    End If
    ' End Exact Match check

    ' Start Negative Match check
    If p.firstColumnToExclude > -1 Then
        If LCase$(p.originalArray(ipRow, p.firstColumnToExclude)) = LCase$(p.firstValueToExclude) Then Exit Function
    End If
    If p.secondColumnToExclude > -1 Then
        If LCase$(p.originalArray(ipRow, p.secondColumnToExclude)) = LCase$(p.secondValueToExclude) Then Exit Function
    End If
    If p.thirdColumnToExclude > -1 Then
        If LCase$(p.originalArray(ipRow, p.thirdColumnToExclude)) = LCase$(p.thirdValueToExclude) Then Exit Function
    End If
    ' End Negative Match check

    ' Start isBetween check
    If p.firstColumnIsBetween > -1 Then
        If p.originalArray(ipRow, p.firstColumnIsBetween) < p.firstLowValue Or p.originalArray(ipRow, p.firstColumnIsBetween) > p.firstHighValue Then Exit Function
    End If
    If p.secondColumnIsBetween > -1 Then
        If p.originalArray(ipRow, p.secondColumnIsBetween) < p.secondLowValue Or p.originalArray(ipRow, p.secondColumnIsBetween) > p.secondHighValue Then Exit Function
    End If
    If p.thirdColumnIsBetween > -1 Then
        If p.originalArray(ipRow, p.thirdColumnIsBetween) < p.thirdLowValue Or p.originalArray(ipRow, p.thirdColumnIsBetween) < p.thirdHighValue Then Exit Function
    End If
    ' End isBetween check
    RowValidates = True

End Function

Unfortunately I don't have you spreadsheet so I can't test the code for correctness but I can say that it compiles without error and has no relevant RubberDuck code inspection warnings.