VBA Join arrays together

[henrik2h]

On a sheet I am calculating a number of arrays, one by one, by changing an input each time. I then store them in a new large array i VBA with looping through each cell. Then I write back the entire new large array onto the worksheet.

For example
Array 1 = (10 rows by 5 columns)
Array 2 = (10 rows by 5 columns) etc always same size

ArrayCombined = (20 rows by 5 columns), ie the arrays should just be added after each other until all the initial arrays are calculated.

Is there another way than looping this into the ArrayCombined? Could the entire Array2 be added without looping?

 

[rlv01]

One way w/o looping

Sub ArrayCombine1()
    Dim Array1(1 To 10, 1 To 5)
    Dim Array2(1 To 10, 1 To 5)
    Dim ArrayCombined As Variant
    Dim WS As Worksheet
    
    
    'Begin code to populate Array1 & Array2
    '
    ' (your code)
    '
    'End code to populate Array1 & Array2
    
    
    '--- Combine Array1 & Array2 without looping ---
    
    Set WS = ThisWorkbook.Worksheets.Add 'Add temp worksheet
    
    With WS
        'Write 1st array to worksheet
        .Cells(1, 1).Resize(UBound(Array1, 1), UBound(Array1, 2)).Value = Array1
        
        'Write 2nd array to worksheet
        .Cells(1, 1).Offset(UBound(Array2, 1)).Resize(UBound(Array2, 1), UBound(Array2, 2)).Value = Array2
        
        'Combine Arrays
        ArrayCombined = .UsedRange.Value
        
        'Delete temp worksheet
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Sub

 

[henrik2h]

Thank you, this is the kind of solution I would imagine but I was hoping it could be done without interacting with a worksheet. Otherwise it is exactly what I wanted, however, the combined array is 5 million cells and I am trying to see if there is a solution that will speed things up. I haven’t tried it yet but I think it will be slower than looping cell by cell, we will see.

In any circumstance thank you for your efforts

 

[rlv01]

but I was hoping it could be done without interacting with a worksheet.

Probably not possible. If you don't want to use a worksheet, you are likely back to looping.

the combined array is 5 million cells and I am trying to see if there is a solution that will speed things up. I haven’t tried it yet but I think it will be slower than looping cell by cell, we will see.

If what you mean by 'looping cell by cell' is loading cell values into an array, then it is MUCH faster to load the entire range in the manner I demonstrated. But if you are talking about looping through two arrays in memory to load their values into a 3rd array in memory, then I don't think you can know for sure unless you test while timing execution.

 

[Alex Blakenburg]

@rlv01 - I think the offset in this is meant to refer to Array1 .Cells(1, 1).Offset(UBound(Array2, 1))

 

[rlv01]

@rlv01 - I think the offset in this is meant to refer to Array1 .Cells(1, 1).Offset(UBound(Array2, 1))

Yes, you are correct. An unfortunate find/replace error.

Sub ArrayCombine1()
    Dim Array1(1 To 10, 1 To 5)
    Dim Array2(1 To 10, 1 To 5)
    Dim ArrayCombined As Variant
    Dim WS As Worksheet
  
  
    'Begin code to populate Array1 & Array2
    '
    ' (your code)
    '
    'End code to populate Array1 & Array2
  
  
    '--- Combine Array1 & Array2 without looping ---
  
    Set WS = ThisWorkbook.Worksheets.Add 'Add temp worksheet
  
    With WS
        'Write 1st array to worksheet
        .Cells(1, 1).Resize(UBound(Array1, 1), UBound(Array1, 2)).Value = Array1
      
        'Write 2nd array to worksheet
        .Cells(1, 1).Offset(UBound(Array1, 1)).Resize(UBound(Array2, 1), UBound(Array2, 2)).Value = Array2
      
        'Combine Arrays
        ArrayCombined = .UsedRange.Value
      
        'Delete temp worksheet
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Sub

 

[Jaafar Tribak]

Using array pointers is fast and should save you the need to loop through the arrays or use a tmp worksheet.

Try this Join_2D_Arrays function:

Option Explicit

#If Win64 Then
    Const VARIANT_SIZE = 24&
    Const PTR_LEN = 8&
#Else
    Const VARIANT_SIZE = 16&
    Const PTR_LEN = 4&
#End If

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As LongPtr)
    Private Declare PtrSafe Function SafeArrayAccessData Lib "oleaut32" Alias "#23" (ByVal psa As LongPtr, pData As LongPtr) As Long
    Private Declare PtrSafe Function SafeArrayUnaccessData Lib "oleaut32" Alias "#24" (ByVal psa As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As LongPtr)
    Private Declare Function SafeArrayAccessData Lib "oleaut32" Alias "#23" (ByVal psa As LongPtr, pData As LongPtr) As Long
    Private Declare Function SafeArrayUnaccessData Lib "oleaut32" Alias "#24" (ByVal psa As LongPtr) As Long
#End If


Function Join_2D_Arrays(ByVal Ar1 As Variant, ByVal Ar2 As Variant) As Variant()

    Const S_OK = 0&
    Dim psa1 As LongPtr, pData1 As LongPtr
    Dim psa2 As LongPtr, pData2 As LongPtr
    Dim vJoinedArray As Variant
    Dim lRowsCount1 As Long, lRowsCount2 As Long
    Dim lColCount1 As Long, lColCount2 As Long
    Dim n As Long
  
    ReDim vJoinedArray(1& To UBound(Ar1, 1&) + UBound(Ar2, 1&) + 1&, 1& To UBound(Ar1, 2&))
  
    Call CopyMemory(psa1, ByVal VarPtr(Ar1) + 8&, PTR_LEN)
    If SafeArrayAccessData(psa1, pData1) <> S_OK Then
        GoTo errHandler
    End If
    lRowsCount1 = UBound(Ar1, 1&):      lColCount1 = UBound(Ar1, 2&)
    For n = 0& To UBound(Ar1, 2&) - 1&
        If n < lColCount1 Then
            Call CopyMemory(vJoinedArray(1&, n + 1&), ByVal pData1 + (n * VARIANT_SIZE * lRowsCount1), lRowsCount1 * VARIANT_SIZE)
        End If
    Next n
    Call SafeArrayUnaccessData(psa1)
  
    Call CopyMemory(psa2, ByVal VarPtr(Ar2) + 8&, PTR_LEN)
    If SafeArrayAccessData(psa2, pData2) <> S_OK Then
        GoTo errHandler
    End If
    lRowsCount2 = UBound(Ar2, 1&):       lColCount2 = UBound(Ar2, 2&)
    For n = 0& To UBound(Ar2, 2&) - 1&
        If n < lColCount1 Then
            Call CopyMemory(vJoinedArray(lRowsCount1 + 1&, n + 1&), ByVal pData2 + (n * VARIANT_SIZE * lRowsCount2), lRowsCount2 * VARIANT_SIZE)
        End If
    Next n
    Call SafeArrayUnaccessData(psa2)
  
    Join_2D_Arrays = vJoinedArray
  
    For n = 0& To UBound(Ar1, 2&) - 1&
        If n < lColCount1 Then
            Call ZeroMemory(vJoinedArray(1&, n + 1&), ByVal UBound(vJoinedArray, 1&) * VARIANT_SIZE)
        End If
    Next n
  
    Exit Function
errHandler:
    MsgBox "Unable to get the array data."

End Function

Usage Example:

Sub Example()

    Dim Array1 As Variant, Array2 As Variant
    Dim ArrayCombined As Variant
  
    ' Range("A1:E10") (10 rows by 5 columns) and
    ' Range("H1:L10") (10 rows by 5 columns)
    ' must first be filled with data before assigning to arrays.
    Array1 = Range("A1:E10")
    Array2 = Range("H1:L10")
  
    ArrayCombined = Join_2D_Arrays(Array1, Array2)
  
    ''Range("A1:E10") (20 rows by 5 columns)
    ' is the target range that will be filled with the joined arrays.
    Range("A20:E40") = ArrayCombined

End Sub

 

[henrik2h]

Thank you, looks pretty advanced, which is also a problem since there is no way I would be able to troubleshoot/modify this myself. But I will have a look into it for sure.

Best regards