Visual Basic > Other sample source codes

Visual Basic Code > Combining the contents of two 2D arrays

Combining the contents of two 2D arrays

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
'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