I'm trying to optimize my FilterArray function so I've thought to use the sorted column (when available).
The original function loops through all items in the array, make comparison in various columns and build the resulting array.
In this new version, I want to reduce the number of main loop's iterations by finding the first and last valid row in the sorted column, so I've added a first loop that:
- Compare the value in the sorted column and lowest acceptable limit
- When the first valid row is founded, store it and start searching for high limit
- If high limit is founded or upper bound is reached, exit the loop
- Pass to the main loop the valid range in which search
This new approach works and can reduce a lot the time of execution, but not always. From an intuitive point of view, I can understand that it is an optimization when the first loop reduces at least ?a bit? the number of loops of the main loop.. But..
1- How can I calculate when is actually convenient to use it?
I'm really not familiar with the concept of complexity, but for the bit I was able to understand this new approach is not reducing the magnitude of complexity, but in those cases where the first loop works well the running time is sensibly lower...
2- What kind of optimization is this? Sorry if this is not a good question..
In this first piece of code, I'm assuming that the order of sortedColumn is ascending because this is the only way in which variable's name make sense (I've written first for ascending order and then adjusted for both the orders).
You'll find the correct code below.
You'll find the new code that search in sorted column between '---------------
Thank you in advance!
Function FilterArray(ByVal originalArray As Variant, _
Optional arrayOfColumnToReturn As Variant, _
Optional sortedColumn As Integer = -1, Optional IsAscendingSorted As Boolean, Optional sortedColumnLowValue As Variant, Optional sortedColumnHighValue 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
' 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
firstRow = LBound(originalArray, 1)
lastRow = UBound(originalArray, 1)
firstColumn = LBound(arrayOfColumnToReturn)
lastColumn = UBound(arrayOfColumnToReturn)
' If the caller don't pass an array for partial match check if it pass the special 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
'-------------------------------------------------------------------------------------------------------------------
If sortedColumn > -1 Then
Dim ImSearchingForLowLine As Boolean
Dim lowRow As Long
Dim highRow As Long
highRow = lastRow 'Set default values that won't allow to run the Main loop if First loop don't change them.
lowRow = lastRow + 1
ImSearchingForLowLine = True
'First loop
For row = firstRow To lastRow
If ImSearchingForLowLine Then
If originalArray(row, sortedColumn) < sortedColumnLowValue Then
GoTo NextRow
Else
'This second check is needed to avoid false positive.
If originalArray(row, sortedColumn) <= sortedColumnHighValue Then
'Now I've found the first valid row, I store it and start search for last valid row
lowRow = row
ImSearchingForLowLine = False
End If
End If
Else
If originalArray(row, sortedColumn) > sortedColumnHighValue Then
'Now row is the first invalid row.
highRow = row - 1
Exit For
Else
GoTo NextRow
End If
End If
NextRow:
Next row
firstRow = lowRow
lastRow = highRow
End If
'-------------------------------------------------------------------------------------------------------------------
'Main Loop
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, LBound(tempFilteredArray, 1) To filteredArrayRow)
For col = firstColumn To lastColumn
tempFilteredArray(col, filteredArrayRow) = originalArray(row, arrayOfColumnToReturn(col))
Next col
SkipRow:
Next row
If filteredArrayRow > LBound(tempFilteredArray, 1) - 1 Then
FilterArray = Inverti_matrice(tempFilteredArray) 'This is similar to Application.Transpose
End If
Erase originalArray
Erase arrayOfColumnToReturn
If IsArray(partialMatchColumnsArray) Then Erase partialMatchColumnsArray
If IsArray(tempFilteredArray) Then Erase tempFilteredArray
End Function
Code with both sorting orders:
Function FilterArray(ByVal originalArray As Variant, _
Optional arrayOfColumnToReturn As Variant, _
Optional sortedColumn As Integer = -1, Optional IsAscendingSorted As Boolean, Optional sortedColumnLowValue As Variant, Optional sortedColumnHighValue 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
' 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
firstRow = LBound(originalArray, 1)
lastRow = UBound(originalArray, 1)
firstColumn = LBound(arrayOfColumnToReturn)
lastColumn = UBound(arrayOfColumnToReturn)
' If the caller don't pass an array for partial match check if it pass the special 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
'-------------------------------------------------------------------------------------------------------------------
If sortedColumn > -1 Then
Dim ImSearchingForLowLine As Boolean
Dim lowRow As Long
Dim highRow As Long
highRow = IIf(IsAscendingSorted, lastRow, firstRow) 'Set default values that won't allow to run the Main loop if First loop don't change them.
lowRow = IIf(IsAscendingSorted, lastRow + 1, firstRow - 1)
ImSearchingForLowLine = True
'First loop
'Depending from the sorting order, loop from FirstToLast or LastToFirst
For row = IIf(IsAscendingSorted, firstRow, lastRow) To IIf(IsAscendingSorted, lastRow, firstRow) Step IIf(IsAscendingSorted, 1, -1)
If ImSearchingForLowLine Then
If originalArray(row, sortedColumn) < sortedColumnLowValue Then
GoTo NextRow
Else
'This second check is needed to avoid false positive.
If originalArray(row, sortedColumn) <= sortedColumnHighValue Then
'Now I've found the first valid row, I store it and start search for last valid row
lowRow = row
ImSearchingForLowLine = False
End If
End If
Else
If originalArray(row, sortedColumn) > sortedColumnHighValue Then
'Now row is the first invalid row.
highRow = row + IIf(IsAscendingSorted, -1, 1)
Exit For
Else
GoTo NextRow
End If
End If
NextRow:
Next row
firstRow = IIf(IsAscendingSorted, lowRow, highRow)
lastRow = IIf(IsAscendingSorted, highRow, lowRow)
End If
'-------------------------------------------------------------------------------------------------------------------
'Main Loop
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, LBound(tempFilteredArray, 1) To filteredArrayRow)
For col = firstColumn To lastColumn
tempFilteredArray(col, filteredArrayRow) = originalArray(row, arrayOfColumnToReturn(col))
Next col
SkipRow:
Next row
If filteredArrayRow > LBound(tempFilteredArray, 1) - 1 Then
FilterArray = Inverti_matrice(tempFilteredArray) 'This is similar to Application.Transpose
End If
Erase originalArray
Erase arrayOfColumnToReturn
If IsArray(partialMatchColumnsArray) Then Erase partialMatchColumnsArray
If IsArray(tempFilteredArray) Then Erase tempFilteredArray
End Function