'********************************************************************************************************** ' Name: createStringArray ' Author: mielk | 2015-01-25 ' ' Description: Function to create 1D array with the given string items. ' ' Parameters: ' items Items to be inserted into result array. ' * This is parameter of ParamArray type. That means, function accept custom number ' of items (up to 30). ' * Each given item should be string. ' * Any primitive value other than string is converted to string before being ' inserted. ' * Any value that cannot be converted to String (i.e. array or object) is ignored. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2015-01-25 mielk Function created. '********************************************************************************************************** Public Function createStringArray(ParamArray items() As Variant) As String() Const METHOD_NAME As String = "createStringArray" '------------------------------------------------------------------------------------------------------ Dim result() As String Dim varItem As Variant '------------------------------------------------------------------------------------------------------ 'Iterate through all the elements in param array [items]. -------------------------------------------| For Each varItem In items '| '| 'Check if current item is not array nor object - those types of data cannot be converted ----| '| 'to string and they are ignored. '| '| If Not VBA.IsArray(varItem) And Not VBA.IsObject(varItem) Then '| '| Call addEntry(result, varItem) '| '| End If '| '| '--------------------------------------------------------------------------------------------| '| '| Next varItem '| '----------------------------------------------------------------------------------------------------| 'Assign result array to the result of this function. createStringArray = result End Function '********************************************************************************************************** ' Name: addEntry ' Author: mielk | 2013-04-26 ' ' Comment: Function to add the given entry to the specified 1D array. ' The given array will be expanded by one row, so this must be dynamic array. ' ' Parameters: ' arr Array where the value is to be added. ' It has to be 1D array, otherwise TooManyDimensionsException will be thrown. ' It has to be dynamic array, otherwise StaticArrayException will be thrown. ' value Value to be added. It can be value of any type (including objects). ' ' ' Exceptions: ' NotArrayException Thrown when [arr] parameter is not an array. ' TooManyDimensionsException Thrown if the given array has more than 1 dimension. ' StaticArrayException Thrown if the given array is not dynamic array and cannot be resized. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2013-04-26 mielk Method created. '********************************************************************************************************** Public Sub addEntry(ByRef arr As Variant, ByRef value As Variant) Const METHOD_NAME As String = "addEntry" '------------------------------------------------------------------------------------------------------ Const START_INDEX As Integer = 1 'Used to create new array if parameter [arr] is not declared '------------------------------------------------------------------------------------------------------ Dim lowBound As Long Dim upBound As Long Dim lngCounter As Long Dim varTemp As Variant '------------------------------------------------------------------------------------------------------ 'Check if the given parameter [arr] is an array and if it is dynamic. -------------------------------| 'If it is not an array, code is moved to the label NotArrayException. '| 'If it is an array, but is not dynamic, code jumps to the label StaticArrayException. '| If Not VBA.IsArray(arr) Then GoTo NotArrayException '| If Not isDynamicArray(arr) Then GoTo StaticArrayException '| '----------------------------------------------------------------------------------------------------| 'Check if the given array has no more than one dimension. If it has more dimensions, code will ------| 'jump to the label NotArrayException. '| If countDimensions(arr) > 1 Then GoTo TooManyDimensionsException '| '----------------------------------------------------------------------------------------------------| 'Find the low and up bound of the result array. -----------------------------------------------------| 'For arrays already initialized low bound remain unchanged and up bound will be incremented by 1. '| 'For arrays not initialized yet, low bound and up bound will be equal to const START_INDEX. '| If isDefinedArray(arr) Then '| lowBound = LBound(arr) '| upBound = UBound(arr) + 1 '| Else '| lowBound = START_INDEX '| upBound = START_INDEX '| End If '| '----------------------------------------------------------------------------------------------------| 'Resize the given array using bounds calculated above and add the given parameter [value]. ----------| ReDim Preserve arr(lowBound To upBound) '| '| 'Before adding value to the array, it has to be checked if the value is an object ---------------| '| 'or a primitive value, because there is a difference in appending objects and non-objects. '| '| If VBA.IsObject(value) Then '| '| Set arr(upBound) = value '| '| Else '| '| arr(upBound) = value '| '| End If '| '| '-------------- [If VBA.IsObject(value) Then] ---------------------------------------------------| '| '| '----------------------------------------------------------------------------------------------------| '========================================================================================================== ExitPoint: Exit Sub '---------------------------------------------------------------------------------------------------------- NotArrayException: 'Error handler for the case if the given parameter [arr] is not an array. GoTo ExitPoint TooManyDimensionsException: 'Error handler for the case if the given array has more than one dimension. GoTo ExitPoint StaticArrayException: 'Error handler for the case if the given array is static and cannot be resized to add new item. GoTo ExitPoint End Sub '********************************************************************************************************** ' Name: isDynamicArray ' Author: mielk | 2012-03-27 ' ' Comment: Checks if a given parameter is a dynamic array. ' Function works properly only on arrays with no more than three dimensions. If an array has ' more than three dimensions, the exception TooManyDimensionsException is thrown. ' ' Parameters: ' arr Array to be tested. ' ' Returns: ' Boolean True - if arr is a dynamic (resizable) array. ' False - if parameter arr is not an array or it is a fixed array. ' ' ' Exceptions: ' TooManyDimensionsException ' Thrown if the given array has more than three dimensions. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2012-03-27 mielk Function created. '********************************************************************************************************** Public Function isDynamicArray(arr As Variant) As Boolean Const METHOD_NAME As String = "isDynamicArray" '------------------------------------------------------------------------------------------------------ 'The following commands are executed only when the given parameter is 'an array. There is no point to check whether a parameter is a 'dynamic array, if it is not array at all. If VBA.IsArray(arr) Then 'Function tries to resize the given array (the use of functions 'LBound and UBound assures that the new dimension is equal to the 'previous one). The trick is that the dimensions of non-dynamic 'arrays are fixed and any attempt to resize them would generate 'an error that causes moving code execution to errHandler label 'and by that fact leaving this function with False value. On Error GoTo StaticArray Select Case countDimensions(arr) Case 0 'If arr is an array but has no dimensions, it has to be 'a dynamic array, since the fixed arrays always have at least 'one dimension. Case 1 If UBound(arr, 1) >= LBound(arr, 1) Then ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1)) End If Case 2 ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), _ LBound(arr, 2) To UBound(arr, 2)) Case 3 ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), _ LBound(arr, 2) To UBound(arr, 2), _ LBound(arr, 3) To UBound(arr, 3)) Case Else 'Functions doesn't work for arrays with more than three 'dimensions. In such case the code execution move to the 'label TooManyDimensionsException. GoTo TooManyDimensionsException End Select 'The statement below can be reached only if no error occured when 'trying to resize an array (what is possible only for dynamic 'arrays). isDynamicArray = True End If '========================================================================================================== ExitPoint: Exit Function '---------------------------------------------------------------------------------------------------------- StaticArray: isDynamicArray = False GoTo ExitPoint '---------------------------------------------------------------------------------------------------------- TooManyDimensionsException: '(...) 'Put your own error handling here for a case if the given parameter has too many dimensions '(the function works only for array with up to three dimensions). 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 '********************************************************************************************************** ' 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