'********************************************************************************************************** ' Name: filterArray ' Author: mielk | 2014-08-29 ' ' Comment: Function to filter the given 2D array by the specified value in the specified ' column. ' ' Parameters: ' arr The source array. ' It must be 2D array. If the given parameter is not an array or it has more or less ' than two dimensions, the proper exception will be raised. ' column The index number of column by which the source array is to be filtered. ' value The value by which the source array is to be filtered. ' includeMatched Optional parameter of a Boolean type. ' * It defines if the array rows having the specified value in the specified column ' should be included or excluded from the result array. ' * If this value is set to True, only rows having the given value in the specified ' column will be returned. ' * If this value is set to False, the result array contains only rows that have ' other value in the specified column. ' * In fact, function filterArray with parameter [includeMatch] set to False is the ' exact opposite to the same function invoked with parameter [includeMatch] set ' to True. ' Default value for this parameter is True, so if you skip it, only rows with ' matching value in the specified column will be returned. ' ' ' ' Returns: ' Variant() Array containing all the values from the source array that have the given value ' in the specified array (if [includeMatch] parameter is set to True) or all the ' rows having other value in this column (in [includeMatch] parameter is set to ' False). ' ' ' ' Exceptions: ' NotArrayException Thrown if the given parameter is not an array. ' DimensionsException Thrown if the array passed to this function has less or more than two ' dimensions (only 2D arrays can be filtered by this function). ' ColumnOutOfRangeException Thrown if the given column by which the array is to be sorted is ' greater than the total number of columns in this array. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2014-08-29 mielk Function created. '********************************************************************************************************** Public Function filterArray(arr As Variant, column As Integer, value As Variant, _ Optional includeMatched As Boolean = True) As Variant Const METHOD_NAME As String = "filterArray" '------------------------------------------------------------------------------------------------------ Dim results() As Variant Dim row As Long Dim col As Integer Dim found As Long '------------------------------------------------------------------------------------------------------ 'Checks if the given parameter [arr] is an array. If not, code --------------------------------------| 'execution moves to the NotArrayException label. '| If Not isDefinedArray(arr) Then GoTo NotArrayException '| '----------------------------------------------------------------------------------------------------| 'Only 2-dimensional arrays can be sorted by this function, so check if the array passed -------------| 'as a parameter has exactly two dimensions. If it has less or more dimensions, code execution '| 'moves to the DimensionsException label. '| If countDimensions(arr) <> 2 Then GoTo DimensionsException '| '----------------------------------------------------------------------------------------------------| 'Iterate through all the rows of the source array. --------------------------------------------------| For row = 1 To UBound(arr, 2) '| '| 'For each row of the source array compare the value in the specified column with the --------| '| 'based value given as a parameter [value]. '| '| If (arr(column, row) = value) = includeMatched Then '| '| '| '| 'If this row is to be included in the result, add new row to the result array ... ---| '| '| found = found + 1 '| '| '| ReDim Preserve results(LBound(arr, 1) To UBound(arr, 1), 1 To found) '| '| '| '| '| '| '... and populate it with the values from the source array. '| '| '| For col = LBound(arr, 1) To UBound(arr, 1) '| '| '| results(col, found) = arr(col, row) '| '| '| Next col '| '| '| '------------------------------------------------------------------------------------| '| '| '| '| End If '| '| '--------------------------------------------------------------------------------------------| '| '| Next row '| '----------------------------------------------------------------------------------------------------| 'Assign the result array to the result of this function. filterArray = results '========================================================================================================== ExitPoint: Exit Function '---------------------------------------------------------------------------------------------------------- NotArrayException: 'Error handling for the case when the parameter passed to the function is not an array ... GoTo ExitPoint DimensionsException: 'Error handling for the case when the number of dimensions of the array passed to this function 'is different than 2 ... GoTo ExitPoint ColumnOutOfRangeException: 'Error handling for the case when the given column index is greater than the total number of 'columns in this array ... GoTo ExitPoint End Function '********************************************************************************************************** ' Name: isDefinedArray ' Author: mielk | 2012-03-27 ' ' Description: Function to check if the given parameter is an array with dimensions and sizes already ' declared. ' ' Parameters: ' arr Parameter to be tested. ' ' Returns: ' Boolean True - if parameter [arr] is an array and its dimensions and sizes has been already ' defined. ' False - if parameter [arr] is not an array or it is declared as a dynamic array but its ' dimension and size have not been defined yet. ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2012-03-27 mielk Function created. ' 2014-08-10 mielk Case about arrays with negative up bound instead of being not declared. '********************************************************************************************************** Public Function isDefinedArray(arr As Variant) As Boolean Const METHOD_NAME As String = "isDefinedArray" '------------------------------------------------------------------------------------------------------ Dim upBound As Long Dim lowBound As Long '------------------------------------------------------------------------------------------------------ 'Try to assign bottom and top bound of the given parameter. 'If it is not an array or is not declared yet, code will move to 'the label NotArrayException and function will return False. On Error GoTo NotArrayException upBound = UBound(arr, 1) lowBound = LBound(arr, 1) 'In some cases, it is possible to get LBound and UBound of a dynamic array 'althought it is not declared yet (i.e. arrays returned as a result of VBA 'built-in Split function if empty string is passed as a parameter), 'however in this case UBound will be lower than LBound. isDefinedArray = (upBound >= lowBound) '========================================================================================================== ExitPoint: Exit Function '---------------------------------------------------------------------------------------------------------- NotArrayException: GoTo ExitPoint End Function '********************************************************************************************************** ' Name: countDimensions ' Author: mielk | 2012-03-03 ' ' Comment: Returns the number of dimensions of the given VBA array. ' ' Parameters: ' arr Array for which number of dimensions is to be returned. ' ' Returns: ' Integer The number of dimensions of the given VBA array. ' If the given value is not an array function returns -1. ' If the given value is declared as a dynamic array but its dimensions have not been ' declared yet, 0 is returned. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2012-03-03 mielk Function created. ' 2014-06-15 mielk Returned type changed to Integer to allow -1 to be returned. ' For non-arrays values -1 is returned. '********************************************************************************************************** Public Function countDimensions(arr As Variant) As Integer Const METHOD_NAME As String = "countDimensions" '------------------------------------------------------------------------------------------------------ Dim bound As Long '------------------------------------------------------------------------------------------------------ If VBA.IsArray(arr) Then On Error GoTo NoMoreDimensions Do bound = UBound(arr, countDimensions + 1) countDimensions = countDimensions + 1 Loop Else countDimensions = -1 End If '---------------------------------------------------------------------------------------------------------- NoMoreDimensions: End Function