How do I Merge two Arrays in VBA

Question

Given   Dim arr1 As Variant Dim arr2 As Variant Dim arr3 As Variant  arr1   Array  A   1   B   2  arr2   Array  C   3   D   4    What kind of operations can I do on arr1 and arr2 and store result in arr3 such that     arr3     A    C   1  3   B    D   2  4

User · Answer

Unfortunately there is no way to append / merge / insert / delete elements in arrays using VBA without doing it element by element, different from many modern languages, like Java or Javascript.

It's possible using split and join to do it, like a previous answer has showed, but it is a slow method and it is not generic.

For my personal use, I've implemented a splice functions for 1D arrays, similar to Javascript or Java. splice get an array and optionally delete some elements from a given position and also optionally insert an array in that position

'*************************************************************
'*                      Fill(N1,N2)
'* Create 1 dimension array with values from N1 to N2 step 1
'*************************************************************
Function Fill(N1 As Long, N2 As Long) As Variant
Dim Arr As Variant
If N2 < N1 Then
  Fill = False
  Exit Function
End If
Fill = WorksheetFunction.Transpose(
          Evaluate("Row(" & N1 & ":" & N2 & ")"))
End Function
'**********************************************************************
'*                        Slice(AArray, [N1,N2])
'* Slice an array between indices N1 to N2
'***********************************************************************
Function Slice(VArray As Variant, Optional N1 As Long = 1, 
               Optional N2 As Long = 0) As Variant
Dim Indices As Variant
If N2 = 0 Then N2 = UBound(VArray)
If N1 = LBound(VArray) And N2 = UBound(VArray) Then
   Slice = VArray
Else
  Indices = Fill(N1, N2)
  Slice = WorksheetFunction.Index(VArray, 1, Indices)
End If
End Function
'************************************************
'*                 AddArr(V1,V2, [V3])
'* Concatena 2 ou 3 vetores
'**************************************************
Function AddArr(V1 As Variant, V2 As Variant, 
  Optional V3 As Variant = 0, Optional Sep = "#") As Variant
Dim Arr As Variant
Dim Ini As Integer
Dim N As Long, K As Long, I As Integer
  Arr = V1
  Ini = UBound(Arr)
  N = UBound(V1) - LBound(V1) + 1 + UBound(V2) - LBound(V2) + 1
  ReDim Preserve Arr(N)
  K = 0
  For I = LBound(V2) To UBound(V2)
    K = K + 1
    Arr(Ini + K) = V2(I)
  Next I
If IsArray(V3) Then
  Ini = UBound(Arr)
  N = UBound(Arr) - LBound(Arr) + 1 + UBound(V3) - LBound(V3) + 1
  ReDim Preserve Arr(N)
  K = 0
  For I = LBound(V3) To UBound(V3)
    K = K + 1
    Arr(Ini + K) = V3(I)
  Next I
End If
AddArr = Arr
End Function

'**********************************************************************
'*                        Slice(AArray,Ind, [ NElme, Vet] )
'* Delete NELEM (default 0) element from position IND in VARRAY
'* and optionally insert an array VET in that postion
'***********************************************************************
Function Splice(VArray As Variant, Ind As Long, 
  Optional NElem As Long = 0, Optional Vet As Variant = 0) As Variant
Dim V1, V2
If Ind < LBound(VArray) Or Ind > UBound(VArray) Or NElem < 0 Then
  Splice = False
  Exit Function
End If
V2 = Slice(VArray, Ind + NElem, UBound(VArray))
If Ind > LBound(VArray) Then
  V1 = Slice(VArray, LBound(VArray), Ind - 1)
  If IsArray(Vet) Then
     Splice = AddArr(V1, Vet, V2)
  Else
     Splice = AddArr(V1, V2)
  End If
Else
  If IsArray(Vet) Then
     Splice = AddArr(Vet, V2)
  Else
     Splice = V2
  End If
End If

End Function

For testing

Sub TestSplice()
Dim V, Res
Dim J As Integer
V = Fill(100, 109)
Res = Splice(V, 2, 2, Array(201, 202))
PrintArr (Res)
End Sub

'************************************************
'*                 PrintArr(VArr)
'* Print the array VARR
'**************************************************
Function PrintArr(VArray As Variant)
Dim S As String
S = Join(VArray, ", ")
MsgBox (S)
End Function

Results in

100,201,202,103,104,105,106,107,108,109

User · Answer

Unfortunately  the Array type in VB6 didn t have all that many razzmatazz features  You are pretty much going to have to just iterate through the arrays and insert them manually into the third  Assuming both arrays are of the same length  Dim arr1   As Variant Dim arr2   As Variant Dim arr3   As Variant  arr1     Array  A   1   B   2  arr2     Array  C   3   D   4   ReDim arr3 UBound arr1    UBound arr2    1   Dim i As Integer For i   0 To UBound arr1      arr3 i   2    arr1 i      arr3 i   2   1    arr2 i  Next i   Updated  Fixed the code  Sorry about the previous buggy version  Took me a few minutes to get access to a VB6 compiler to check it

User · Answer

I tried the code provided above  but it gave an error 9 for me  I made this code  and it worked fine for my purposes   I hope others find it useful as well   Function mergeArrays ByRef arr1   As Variant  arr2   As Variant  As Variant      Dim returnThis   As Variant     Dim len1 As Integer  len2 As Integer  lenRe As Integer  counter As Integer     len1   UBound arr1      len2   UBound arr2      lenRe   len1   len2     ReDim returnThis 1 To lenRe      counter   1      Do While counter  lt   len1  get first array in returnThis         returnThis counter    arr1 counter          counter   counter   1     Loop     Do While counter  lt   lenRe  get the second array in returnThis         returnThis counter    arr2 counter - len1          counter   counter   1     Loop  mergeArrays   returnThis End Function

User · Answer

This function will do as JohnFx suggested and allow for varied lengths on the arrays  Function mergeArrays ByVal arr1 As Variant  ByVal arr2 As Variant  As Variant     Dim holdarr As Variant     Dim ub1 As Long     Dim ub2 As Long     Dim bi As Long     Dim i As Long     Dim newind As Long          ub1   UBound arr1    1         ub2   UBound arr2    1          bi   IIf ub1  gt   ub2  ub1  ub2           ReDim holdarr ub1   ub2 - 1           For i   0 To bi             If i  lt  ub1 Then                 holdarr newind    arr1 i                  newind   newind   1             End If              If i  lt  ub2 Then                 holdarr newind    arr2 i                  newind   newind   1             End If         Next i          mergeArrays   holdarr End Function

User · Answer

My preferred way is a bit long  but has some advantages over the other answers    It can combine an indefinite number of arrays at once It can combine arrays with non-arrays  objects  strings  integers  etc   It accounts for the possibility that one or more of the arrays may contain objects It allows the user to choose the base of the new array  0  1  etc     Here it is   Function combineArrays ByVal toCombine As Variant  Optional ByVal newBase As Long   1   Combines an array of one or more 1d arrays  objects  or values into a single 1d array  newBase parameter indicates start position of new array  0  1  etc    Example usage       combineArrays Array Array 1 2 3  Array 4 5 6  Array 7 8    - gt  Array 1 2 3 4 5 6 7 8       combineArrays Array  Cat  Array 2 3 4    - gt  Array  Cat  2 3 4       combineArrays Array  Cat  ActiveSheet   - gt  Array  Cat  ActiveSheet       combineArrays Array ThisWorkbook   - gt  Array ThisWorkbook       combineArrays  Cat   - gt  Array  Cat        Dim tempObj As Object     Dim tempVal As Variant      If Not IsArray toCombine  Then         If IsObject toCombine  Then             Set tempObj   toCombine             ReDim toCombine newBase To newBase              Set toCombine newBase    tempObj         Else             tempVal   toCombine             ReDim toCombine newBase To newBase              toCombine newBase    tempVal         End If         combineArrays   toCombine         Exit Function     End If      Dim i As Long     Dim tempArr As Variant     Dim newMax As Long     newMax   0      For i   LBound toCombine  To UBound toCombine          If Not IsArray toCombine i   Then             If IsObject toCombine i   Then                 Set tempObj   toCombine i                  ReDim tempArr 1 To 1                  Set tempArr 1    tempObj                 toCombine i    tempArr             Else                 tempVal   toCombine i                  ReDim tempArr 1 To 1                  tempArr 1    tempVal                 toCombine i    tempArr             End If             newMax   newMax   1         Else             newMax   newMax    UBound toCombine i     LBound toCombine i   - 1          End If     Next     newMax   newMax    newBase - 1       ReDim newArr newBase To newMax      i   newBase     Dim j As Long     Dim k As Long     For j   LBound toCombine  To UBound toCombine          For k   LBound toCombine j   To UBound toCombine j               If IsObject toCombine j  k   Then                 Set newArr i    toCombine j  k              Else                 newArr i    toCombine j  k              End If             i   i   1         Next     Next      combineArrays   newArr  End Function

User · Answer

Following the  johannes solution  but merging without loosing data  it was missing first elements        Function mergeArrays ByRef arr1   As Variant  arr2   As Variant  As Variant      Dim returnThis   As Variant     Dim len1 As Integer  len2 As Integer  lenRe As Integer  counter As Integer     len1   UBound arr1      len2   UBound arr2      lenRe   len1   len2   1     ReDim returnThis 0 To lenRe      counter   0      For counter   0 To len1  get first array in returnThis         returnThis counter    arr1 counter      Next       For counter   0 To len2  get the second array in returnThis         returnThis counter   len1   1    arr2 counter      Next mergeArrays   returnThis End Function

User · Answer

Here s a version that uses a collection object to combine two 1-d arrays and pass them to a 3rd array  Doesn t work for multi-dimensional arrays   Function joinArrays arr1 As Variant  arr2 As Variant  As Variant  Dim arrToReturn   As Variant  myCollection As New Collection  For Each x In arr1  myCollection Add x  Next  For Each y In arr2  myCollection Add y  Next   ReDim arrToReturn 1 To myCollection Count   For i   1 To myCollection Count  arrToReturn i    myCollection Item i   Next  joinArrays   arrToReturn End Function

User · Answer

To join Array1 and Array2  create a new array say JointArray  Dim JointArray As Variant ReDim JointArray UBound Array1    UBound Array2    1  As Variant For i   0 To UBound JointArray      If i  lt   UBound Array1  Then     JointArray i    Array1 i      Else     JointArray i    Array2 i - UBound Array1  - 1      End If Next

User · Answer

It work if Lbound is different than 0 or 1  You Redim once at start  Function MergeArrays ByRef arr1 As Variant  ByRef arr2 As Variant  As Variant   Test if not isarray then exit If Not IsArray arr1  And Not IsArray arr2  Then Exit Function  Dim arr As Variant Dim a As Long  b As Long  index Array Dim len1 As Long  len2 As Long  nb of item   get len if array don t start to 0 len1   UBound arr1  - LBound arr1    1 len2   UBound arr2  - LBound arr2    1  b   1  position of start index  dim new array ReDim arr b To len1   len2   merge arr1 For a   LBound arr1  To UBound arr1      arr b    arr1 a             b   b   1  move index Next a  merge arr2 For a   LBound arr2  To UBound arr2      arr b    arr2 a      b   b   1  move index Next a   final MergeArrays   arr  End Function

User · Answer

Or even a way that either variable can be uninitialised or an empty array or an array of objects  eg Dictionary objects   Only handles one dimension at a time  though  Also  it APPENDS arr2 to arr1 rather than merges   Function appendArray ByVal arr1 As Variant  ByVal arr2 As Variant  As Variant     Dim holdarr As Variant     Dim ub1 As Long     Dim ub2 As Long     Dim i As Long     Dim newind As Long                                Allows for one or both variants to not be arrays     If IsEmpty arr1  Or Not IsArray arr1  Then         arr1   Array       End If      If IsEmpty arr2  Or Not IsArray arr2  Then         arr2   Array       End If                               Now we assume we DO have two ARRAYS  even if one or the other                               has no elements     ub1   UBound arr1      ub2   UBound arr2       If ub1   -1 Then         appendArray   arr2         Exit Function     End If      If ub2   -1 Then         appendArray   arr1         Exit Function     End If                Copy the first array  We know it is not empty      holdarr   arr1                Grow it to the final size we need  keeping the current contents     ReDim Preserve holdarr ub1   ub2   1                 Set the starting new index     newind   UBound arr1    1                Append the second array  allowing that it might be an array of objects     For i   0 To ub2         If VarType arr2 i     vbObject Then             Set holdarr newind    arr2 i          Else             holdarr newind    arr2 i          End If         newind   newind   1     Next i               Return the appended array     appendArray   holdarr End Function

User · Answer

Function marr arr1 As Variant  arr2 As Variant  As Variant Dim item As Variant     For Each item In arr1         i   i   1     Next item     For Each item In arr2         i   i   1     Next item ReDim MergeData 0 To i  i   1     For Each item In arr1         MergeData i    item         i   i   1     Next item     For Each item In arr2         MergeData i    item         i   i   1     Next item     marr   MergeData End Function

User · Answer

Try this   arr3   Split Join arr1        amp       amp  Join arr2

[arrays] How do I Merge two Arrays in VBA?

Examples related to arrays

Examples related to vba

Examples related to vb6

Examples related to merge