VB and VBA Users Source Code: Combining the contents of two 2D arrays
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Combining the contents of two 2D arrays
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, August 13, 2001
Hits:
636
Category:
Visual Basic General
Article:
The following code joins/appends the contents of two arrays together by resizing then copying values from one array to another. 'Purpose : Combines the contents of two zero based two arrays. 'Inputs : avValues The array to add the values to. ' avAppendValues The array containing the new values to append to avValues 'Outputs : Returns -1 on error, else returns the upper bound of the new array 'Author : Andrew Baker 'Date : 06/07/2001 'Notes : Must use 2d dynamic (i.e. arrays which can be redimensioned) arrays. 'Revisions : Function Array2dAppend(ByRef avValues As Variant, ByRef avAppendValues As Variant) As Long Dim lNumNewCols As Long, lNumNewRows As Long Dim lThisRecord As Long, lThisCol As Long Dim lNumExistingRows As Long, lNumExistingCols As Long Dim lOffset As Long On Error GoTo ErrFailed If IsArray(avAppendValues) Then 'Determine the size of the new array lNumNewCols = UBound(avAppendValues) lNumNewRows = UBound(avAppendValues, 2) If IsArray(avValues) Then 'Resize result array to hold new values lNumExistingRows = UBound(avValues, 2) lOffset = (1 - LBound(avValues, 2)) ReDim Preserve avValues(LBound(avValues, 1) To UBound(avValues, 1), LBound(avValues, 2) To lNumExistingRows + lNumNewRows + lOffset) Else 'Create result array ReDim avValues(0 To lNumNewCols, 0 To lNumNewRows) lOffset = 1 End If lNumExistingCols = UBound(avValues, 1) Array2dAppend = lNumExistingRows + lNumNewRows + 1 'Copy values into result array For lThisRecord = LBound(avValues, 2) To lNumNewRows For lThisCol = LBound(avValues, 1) To lNumExistingCols avValues(lThisCol, lNumExistingRows + lThisRecord + lOffset) = avAppendValues(lThisCol, lThisRecord) Next Next Else 'Return the number of elements in the existing array Array2dAppend = UBound(avValues, 2) End If Exit Function ErrFailed: Debug.Print "Failed Array2dAppend: " & Err.Description Array2dAppend = -1 End Function Sub Test() Dim asVals1() As Variant, asVals2() As Variant Dim lThisVal As Long ReDim asVals1(1 To 2, 1 To 5) ReDim asVals2(1 To 2, 1 To 5) 'Create an array containing "A" to "E" in first col 'and 1 to 5 in second col For lThisVal = 1 To 5 asVals1(1, lThisVal) = lThisVal asVals1(2, lThisVal) = Chr(64 + lThisVal) Next 'Create another array containing "F" to "J" in first col 'and 1 to 5 in second col For lThisVal = 1 To 5 asVals2(1, lThisVal) = lThisVal + 5 asVals2(2, lThisVal) = Chr(64 + lThisVal + 5) Next 'Add the contents of asVals2 to asVals1 Array2dAppend asVals1, asVals2 'Display the new values in asVals1 For lThisVal = 1 To 10 Debug.Print "Row " & lThisVal Debug.Print asVals1(1, lThisVal) Debug.Print asVals1(2, lThisVal) Next End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
