'********************************************************************************************************** ' Name: joinArrays ' Author: mielk | 2013-04-26 ' ' Comment: Joins the given arrays into a single array. ' Function works only with 1D and 2D arrays and can join up to 30 arrays. ' ' Parameters: ' arrays Arrays to be joined. Function can join up to 30 arrays. ' All non-array parameters are ignored. ' All the arrays given to this function should have the same number of dimensions ' (you cannot mix up 1D and 2D arrays). ' ' Returns: ' Variant() The array that is the combination of all arrays given in arrays parameter. ' ----------------------------------------------------------------------------------- ' [1D arrays] ' Function returns 1D arrays with so many items as the sum of items in all given ' source arrays. ' ' Example: ' --------------- ' Assuming the following arrays have been given to this function (with dimensions ' specified in brackets): ' - arr1(1 To 3) 1D array with 3 elements, ' - arr2(10 To 15) 1D array with 6 elements, ' - arr3(-2 To 2) 1D array with 5 elements. ' 1D array with 14 elements will be returned. ' ' ----------------------------------------------------------------------------------- ' [2D arrays] ' 2D arrays can have different number of columns. ' Final array always have as many columns as the widest from the source arrays and as ' many rows as the sum of rows in all source arrays. ' NOTE! First dimension of the array is considered to be a 'column'. ' ' Example: ' --------------- ' Assuming the following arrays have been given to this function (with dimensions ' specified in brackets): ' - arr1(1 To 10, 1 To 2) array with 10 columns and 2 rows ' - arr2(3 To 5, 1 To 10) array with 3 columns and 10 rows ' - arr3(-2 To 6, 4 To 10) array with 8 columns and 7 rows ' The result array will have 10 columns (the number of columns equal to the number of ' columns in the widest source array - arr1 in this example) and 19 rows (sum of the ' rows in all source arrays). ' ' NOTE! To properly join the arrays created directly from Excel worksheet range: ' arr = Range(Cells(row, col), Cells(row2, col2)) ' first you have to transpose them before passing then to this function. ' You can use transposeArray function, presented on our website to avoid the errors ' generated in some specific cases by Excel built-in function Transpose (i.e. if ' the array to be transposed has more than 32767 rows or the content of any array ' element is longer than 256 characters. ' ' ' By default, the result array is indexed from 1. You can change it, by modifying ' FIRST_INDEX constant defined in this function. ' ' ' ' Exceptions: ' DifferentDimensionsException Thrown if the arrays given to this function have different number of ' dimensions, i.e. some arrays are 1D and others are 2D. ' ' TooManyDimensionsException Thrown if any of the arrays given to the function has more than ' 2 dimensions. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2013-04-26 mielk Method created. '********************************************************************************************************** Public Function joinArrays(ParamArray arrays() As Variant) As Variant() Const METHOD_NAME As String = "joinArrays" Const FIRST_INDEX As Byte = 1 '------------------------------------------------------------------------------------------------------ Dim arr As Variant Dim correctArrays() As Variant Dim bytArraysCounter As Byte Dim bytMaxDim As Byte Dim bytArrayDimension As Byte '------------------------------------------------------------------------------------------------------ 'Checks every single source array given to this function. -------------------------------------------| 'Each item that is not an array or is an empty array is ignored. '| 'This loop checks also if all the arrays have the same number of dimensions. '| For Each arr In arrays '| '| 'Check if the current item in the loop is a defined array. If not, it is ignored. -----------| '| If isDefinedArray(arr) Then '| '| bytArrayDimension = countDimensions(arr) '| '| '| '| 'If variable [bytMaxDim] is greater than 0, it means the array currently checked ----| '| '| 'is not the first array in the collection and the final number of dimensions has '| '| '| 'been already worked out. If the number of dimensions of this source array is '| '| '| 'different than the one worked out before, it means the given array have different '| '| '| 'number of dimensions and exception DifferentDimensionsException is thrown. '| '| '| If bytMaxDim > 0 And bytArrayDimension <> bytMaxDim Then '| '| '| '| '| '| GoTo DifferentDimensionsException '| '| '| '| '| '| Else '| '| '| '| '| '| 'If the array currently analyzed is the first array in the collection of '| '| '| 'arrays to be joined, its number of dimension is used to work out the final '| '| '| 'number of dimensions. The number of dimensions of other arrays in the '| '| '| 'collection will be compared to that number. '| '| '| If bytMaxDim = 0 Then bytMaxDim = bytArrayDimension '| '| '| '| '| '| bytArraysCounter = bytArraysCounter + 1 '| '| '| ReDim Preserve correctArrays(1 To bytArraysCounter) '| '| '| correctArrays(bytArraysCounter) = arr '| '| '| '| '| '| End If '| '| '| '------------------------------------------------------------------------------------| '| '| '| '| End If '| '| '--------------------------------------------------------------------------------------------| '| '| Next arr '| '----------------------------------------------------------------------------------------------------| 'For performance reasons, there are separate subfunctions to join 1D and 2D arrays. -----------------| Select Case bytMaxDim '| Case 1: joinArrays = joinArrays1D(FIRST_INDEX, correctArrays) '| Case 2: joinArrays = joinArrays2D(FIRST_INDEX, correctArrays) '| Case Else: GoTo TooManyDimensionsException '| End Select '| '---------------------------------------------------------------------------------------------------| '========================================================================================================== ExitPoint: Exit Function '-------------------------------------------------------------------------- DifferentDimensionsException: '(...) 'Put your own error handling here for a case if the given parameter is not a dictionary. GoTo ExitPoint TooManyDimensionsException: '(...) 'Put your own error handling here for a case if the given parameter is not a dictionary. GoTo ExitPoint End Function '********************************************************************************************************** ' Name: joinArrays1D ' Author: mielk | 2013-04-26 ' ' Comment: Subfunction used to join 1D arrays. ' ' Parameters: ' firstIndex Specified the first index of the result array. ' arrays() Arrays to be joined. ' ' Returns: ' Variant() The array that is the combination of all arrays given to this subfunction. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2013-04-26 mielk Method created. '********************************************************************************************************** Private Function joinArrays1D(firstIndex As Byte, arrays() As Variant) As Variant() Const METHOD_NAME As String = "joinArrays1D" '------------------------------------------------------------------------------------------------------ Dim arr As Variant Dim combined() As Variant Dim lngRows As Long Dim lngResultRow As Long Dim lngSourceRow As Long '------------------------------------------------------------------------------------------------------ 'Loop to count the total number of elements in all source arrays. -----------------------------------| For Each arr In arrays '| lngRows = lngRows + UBound(arr, 1) - LBound(arr, 1) + 1 '| Next arr '| '----------------------------------------------------------------------------------------------------| 'Create a temporary 1D array and resize it to have exactly as many 'elements as the sum of all elements in all source arrays. ReDim combined(firstIndex To lngRows + firstIndex - 1) 'For each source array a loop iterates through all elements of this ---------------------------------| 'array and adds them to the final array. '| lngResultRow = firstIndex '| For Each arr In arrays '| '| '--------------------------------------------------------------------------------------------| '| For lngSourceRow = LBound(arr, 1) To UBound(arr, 1) '| '| combined(lngResultRow) = arr(lngSourceRow) '| '| lngResultRow = lngResultRow + 1 '| '| Next lngSourceRow '| '| '--------------------------------------------------------------------------------------------| '| '| Next arr '| '----------------------------------------------------------------------------------------------------| joinArrays1D = combined End Function '********************************************************************************************************** ' Name: joinArrays2D ' Author: mielk | 2013-04-26 ' ' Comment: Subfunction used to join 2D arrays. ' ' Parameters: ' firstIndex Specified the first index of the result array. ' arrays() 2D arrays to be joined. ' ' Returns: ' Variant() The array that is the combination of all arrays given to this subfunction. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2013-04-26 mielk Method created. '********************************************************************************************************** Private Function joinArrays2D(firstIndex As Byte, arrays() As Variant) As Variant() Const METHOD_NAME As String = "joinArrays2D" '------------------------------------------------------------------------------------------------------ Dim arr As Variant Dim combined() As Variant Dim lngColumnsCount As Long Dim lngMaxCol As Long Dim lngRows As Long Dim lngResultRow As Long Dim lngSourceRow As Long Dim lngResultCol As Long Dim lngSourceCol As Long '------------------------------------------------------------------------------------------------------ 'Loop to count the total number of rows in all source arrays and to ---------------------------------| 'work out the number of columns in the result array. '| For Each arr In arrays '| lngColumnsCount = UBound(arr, 1) - LBound(arr, 1) + 1 '| If lngColumnsCount > lngMaxCol Then lngMaxCol = lngColumnsCount '| lngRows = lngRows + UBound(arr, 2) - LBound(arr, 2) + 1 '| Next arr '| '----------------------------------------------------------------------------------------------------| 'Create a temporary 2D array and resize it to have the number of rows -------------------------------| 'and columns worked out before. '| ReDim Preserve combined(firstIndex To lngMaxCol + firstIndex - 1, _ firstIndex To lngRows + firstIndex - 1) '| '----------------------------------------------------------------------------------------------------| 'For each source array a loop iterates through all elements of this ---------------------------------| 'array and adds them to the final array. '| lngResultRow = firstIndex '| For Each arr In arrays '| '| '--------------------------------------------------------------------------------------------| '| For lngSourceRow = LBound(arr, 2) To UBound(arr, 2) '| '| lngResultCol = firstIndex '| '| '| '| '------------------------------------------------------------------------------------| '| '| For lngSourceCol = LBound(arr, 1) To UBound(arr, 1) '| '| '| combined(lngResultCol, lngResultRow) = arr(lngSourceCol, lngSourceRow) '| '| '| lngResultCol = lngResultCol + 1 '| '| '| Next lngSourceCol '| '| '| '------------------------------------------------------------------------------------| '| '| '| '| lngResultRow = lngResultRow + 1 '| '| '| '| Next lngSourceRow '| '| '--------------------------------------------------------------------------------------------| '| '| Next arr '| '----------------------------------------------------------------------------------------------------| joinArrays2D = combined 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