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.