2

I am currently trying to combine 46 arrays in to a single array. I have scoured the internet, to no prevail and am hoping someone here can help. I did find the below page, but I need to be able to look through each element of the new array in a nested for loop, so using the method below doesn't quite get me to my end goal.

Excel vba - combine multiple arrays into one

Basically, I need to combine my set of 46 arrays in such a way that I can then loop through each element using a nested for loop. ie.

Set of arrays:

myArray1 = (1, 2, 3, 4)
myArray2 = (5, 6, 7)
myArray3 = (8, 9)
myArray4 = (10, 11, 12, 13, 14)
.
.
.
myArray46 = (101, 102, 103)

Combine them to form new array:

myNewArray = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14... 101, 102, 103)

Loop through in nested for loop to check each element against my main array:

For i = LBound(mainArray) to UBound(mainArray)
    For j = LBound(myArray) to UBound(myArray)

    If mainArray(i) = myArray(j) Then
    'do something
    End If

    Next j
Next i

Any help and/ or guidance with this is greatly appreciated!

Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
Dean
  • 2,326
  • 3
  • 13
  • 32
  • Is myArray1 = (1, 2, 3, 4) supposed to be a 4-D array or a 1-D array with 4 elements? ('cause that isn't how you write either) –  Jul 18 '18 at 15:21
  • What the end goal? Are you trying to only insert values into Main Artray that already or dont exist? Havign a more clear picture of what youre trying to achieve might help get at better results/answers – Doug Coats Jul 18 '18 at 15:49
  • @Jeeped they are all 1-D arrays. – Dean Jul 18 '18 at 15:56
  • @DougCoats Basically want to compare elements of each array, mainArray and myArray. If there are two or more elements in myArray for each element in mainArray then either remove the duplicates or make a new array with only elements that appear once. – Dean Jul 18 '18 at 15:59
  • Your last comment greatly changes the scope of your question essentially making it a completely new question. The conditions you've added should be incorporated into your question through an [edit] and even added into the title. –  Jul 18 '18 at 19:19

6 Answers6

5

Since you write in your comments that your end goal is to create an array of unique elements, you might be best served using a dictionary, where you can test for uniqueness as you add each element to dictionary. Something like:

Option Explicit
Function uniqueArr(ParamArray myArr() As Variant) As Variant()
    Dim dict As Object
    Dim V As Variant, W As Variant
    Dim I As Long

Set dict = CreateObject("Scripting.Dictionary")
For Each V In myArr 'loop through each myArr
    For Each W In V 'loop through the contents of each myArr
        If Not dict.exists(W) Then dict.Add W, W
    Next W
Next V


uniqueArr = dict.keys

End Function

Sub tester()
    Dim myArray1, myArray2, myArray3, myArray4, myArray5
    myArray1 = Array(1, 2, 3, 4)
    myArray2 = Array(5, 6, 7, 8)
    myArray3 = Array(9, 10, 11, 12, 13, 14)
    myArray4 = Array(15, 16)
    myArray5 = Array(1, 3, 25, 100)

Dim mainArray

mainArray = uniqueArr(myArray1, myArray2, myArray3, myArray4, myArray5)

End Sub

If you run Tester, you will see mainArray contains:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
25
100
Ron Rosenfeld
  • 53,870
  • 7
  • 28
  • 60
2

Using your data this is how to create one array out of many:

Public Sub TestMe()

    Dim myA, myB, myC, myD, myE
    myA = Array(1, 2, 3, 4)
    myB = Array(5, 6, 7)
    myC = Array(8, 9)
    myD = Array(10, 11, 12, 13, 14)
    myE = Array(101, 102, 103)

    Dim myCombine As Variant
    Dim myNew() As Variant

    Dim myElement As Variant
    Dim myArr As Variant
    Dim cnt As Long

    myCombine = Array(myA, myB, myC, myD, myE)

    For Each myArr In myCombine
        For Each myElement In myArr
            ReDim Preserve myNew(cnt)
            myNew(cnt) = myElement
            cnt = cnt + 1
        Next
    Next

    For cnt = LBound(myNew) To UBound(myNew)
        Debug.Print myNew(cnt)
    Next cnt

End Sub

The "building" of the new array is facilitated through ReDim Preserve, which keeps the old values in the array whenver the dimension of the array changes. And if you want to do something with these arrays, you may use 3 nested loops (a bit slow) and have some check:

Dim cnt2 As Long
For cnt = LBound(myNew) To UBound(myNew)
    For cnt2 = LBound(myCombine) To UBound(myCombine)
        For Each myElement In myCombine(cnt2)
            If myElement = myNew(cnt) Then
                Debug.Print myElement & vbTab & " from " & vbTab & cnt2
            End If
        Next myElement
    Next cnt2
Next cnt

This is what you get on the immediate window:

1    from   0
2    from   0
3    from   0
4    from   0
5    from   1
6    from   1
7    from   1
8    from   2
9    from   2
10   from   3
11   from   3
12   from   3
13   from   3
14   from   3
101  from   4
102  from   4
103  from   4
Vityata
  • 42,633
  • 8
  • 55
  • 100
  • Since OP has 46 arrays, with `Redim Preserve`, you're creating a new array at least 46 times, which can likely cause a sever performance hit. – Zack Jul 18 '18 at 18:41
  • @Zack - 46 arrays * 5 elements per array would be around 250 reinitializations. This cannot be a performance hit in 2018. If we make the reinitializations around half million times, then yeah, it would be a bit slower and making the initialization once would be faster. However, my idea was to show how the combining of the array is done. – Vityata Jul 18 '18 at 19:11
  • There's no guarantee that the average array in OP's actual code only holds 5 elements. – Zack Jul 18 '18 at 19:15
  • @Zack the average array holds around 15-20 elements, times by 46, so roughly 900 reinitialisations. Hardly a slow down at all. – Dean Jul 19 '18 at 06:27
1

Alternate 'brick-by-brick' approach.

Option Explicit

Sub combineArrays()
    Dim myArray1 As Variant, myArray2 As Variant, myArray3 As Variant
    Dim myArray4 As Variant, myArray46 As Variant

    ReDim mainArray(0) As Variant

    myArray1 = Array(1, 2, 3, 4)
    myArray2 = Array(5, 6, 7)
    myArray3 = Array(8, 9)
    myArray4 = Array(10, 11, 12, 13, 14)
    '...
    myArray46 = Array(101, 102, 103)

    mainArray = buildMainArray(myArray1, mainArray)
    mainArray = buildMainArray(myArray2, mainArray)
    mainArray = buildMainArray(myArray3, mainArray)
    mainArray = buildMainArray(myArray4, mainArray)
    mainArray = buildMainArray(myArray46, mainArray)
    ReDim Preserve mainArray(UBound(mainArray) - 1)

    Debug.Print Join(mainArray, ",")

End Sub

Function buildMainArray(arr As Variant, marr As Variant)
    Dim i As Long

    For i = LBound(arr) To UBound(arr)
        marr(UBound(marr)) = arr(i)
        ReDim Preserve marr(UBound(marr) + 1)
    Next i

    buildMainArray = marr
End Function
1

The issue with using Redim Preserve to combine arrays is it can be an expensive operation, since you're basically re-creating the array everytime it's called. Since you have 46 arrays you're combining, you may very well be waiting a while.

Instead, you can loop over the arrays to figure out the total number of elements you need, dimension out your master array, then loop over the arrays again to do the actual assignment/merging. Something like this:

  ' encapsulates code to determine length of an individual array
  ' note that because arrays can have different LBounds in VBA, we can't simply use
  ' Ubound to determine array length
  Public Function GetArrayLength(anArray As Variant) As Integer
     If Not IsArray(anArray) Then
        GetArrayLength = -1
     Else
        GetArrayLength = UBound(anArray) - LBound(anArray) + 1
     End If
  End Function

  Public Function CombineArrays(ParamArray arraysToMerge() As Variant) As Variant
     ' index for looping over the arraysToMerge array of arrays,
     ' and then each item in each array
     Dim i As Integer, j As Integer

     ' variable to store where we are in the combined array
     Dim combinedArrayIndex As Integer

     ' variable to hold the number of elements in the final combined array
     Dim CombinedArrayLength As Integer

     ' we don't initialize the array with an array-length until later,
     ' when we know how long it needs to be.
     Dim combinedArray() As Variant

     ' we have to loop over the arrays twice:
     ' First, to figure out the total number of elements in the combined array
     ' second, to actually assign the values
     ' otherwise, we'd be using Redim Preserve, which can get quite expensive
     ' because we're creating a new array everytime we use it.
     CombinedArrayLength = 0
     For i = LBound(arraysToMerge) To UBound(arraysToMerge)
        CombinedArrayLength = CombinedArrayLength + GetArrayLength(arraysToMerge(i))
     Next i

     ' now that we know how long the combined array has to be,
     ' we can properly initialize it.
     ' you can also use the commented code instead, if you prefer 1-based arrays.
     ReDim combinedArray(0 To CombinedArrayLength - 1)
     ' Redim combinedArray(1 to CombinedArrayLength)

     ' now that the combinedarray is set up to store all the values in the arrays,
     ' we can begin actual assignment
     combinedArrayIndex = LBound(combinedArray)
     For i = LBound(arraysToMerge) To UBound(arraysToMerge)
        For j = LBound(arraysToMerge(i)) To UBound(arraysToMerge(i))
           combinedArray(combinedArrayIndex) = arraysToMerge(i)(j)
           combinedArrayIndex = combinedArrayIndex + 1
        Next j
     Next i

     ' assign the function to the master array we've been using
     CombineArrays = combinedArray
  End Function

To use this function, you'd do something like the following:

  Public Sub TestArrayMerge()
     Dim myArray1() As Variant
     Dim myArray2() As Variant
     Dim myArray3() As Variant
     Dim myArray4() As Variant
     Dim combinedArray As Variant

     myArray1 = Array(1, 2, 3, 4)
     myArray2 = Array(5, 6, 7)
     myArray3 = Array(8, 9)
     myArray4 = Array(10, 11, 12, 13, 14)

     combinedArray = CombineArrays(myArray1, myArray2, myArray3, myArray4)

     If IsArray(combinedArray) Then
        Debug.Print Join(combinedArray, ",")
     End If
  End Sub

Regarding your last bit, that you're using an inner loop to combine the values in your final combined array: Your inner loop doesn't need to start at LBound(myArray). For any value of i, you've already compared it to the elements before it (e.g., when i = 2, it's already been compared to the first element). So you really just need:

    For i = LBound(combinedArray) To UBound(combinedArray) - 1
        For j = i + 1 To UBound(combinedArray)
           ' do whatever you need
        Next j
     Next i
Zack
  • 2,220
  • 1
  • 8
  • 12
0

Perhaps this ...

'To determine if a multi-dimension array is allocated (or empty)
'Works for any-dimension arrays, even one-dimension arrays
Public Function isArrayAllocated(ByVal aArray As Variant) As Boolean

On Error Resume Next
isArrayAllocated = IsArray(aArray) And Not IsError(LBound(aArray, 1)) And LBound(aArray, 1) <= UBound(aArray, 1)
Err.Clear: On Error GoTo 0

End Function

    'To determine the number of items within any-dimension array
    'Returns 0 when array is empty, and -1 if there is an error
    Public Function itemsInArray(ByVal aArray As Variant) As Long
    Dim item As Variant, UBoundCount As Long

    UBoundCount = -1
    If IsArray(aArray) Then
        UBoundCount = 0
        If isArrayAllocated(aArray) Then
            For Each item In aArray
                UBoundCount = UBoundCount + 1
            Next item
        End If
    End If
    itemsInArray = UBoundCount

    End Function

        'To determine the number of dimensions of an array
        'Returns -1 if there is an error
        Public Function nbrDimensions(ByVal aArray As Variant) As Long
        Dim x As Long, tmpVal As Long

        If Not IsArray(aArray) Then
            nbrDimensions = -1
            Exit Function
        End If

        On Error GoTo finalDimension
        For x = 1 To 65536 'Maximum number of dimensions (size limit) for an array that will work with worksheets under Excel VBA
            tmpVal = LBound(aArray, x)
        Next x

        finalDimension:
        nbrDimensions = x - 1
        Err.Clear: On Error GoTo 0

        End Function

        '****************************************************************************************************
        ' To merge an indefinite number of one-dimension arrays together into a single one-dimension array
        ' Usage: mergeOneDimArrays(arr1, arr2, arr3, ...)
        ' Returns an empty array if there is an error
        ' Option Base 0
        '****************************************************************************************************
        Public Function mergeOneDimArrays(ParamArray infArrays() As Variant) As Variant
        Dim x As Long, y As Long, UBoundCount As Long, newUBoundCount As Long
        Dim tmpArr As Variant, allArraysOK As Boolean

        UBoundCount = 0
        allArraysOK = True
        For x = LBound(infArrays) To UBound(infArrays)
            If Not IsArray(infArrays(x)) Or Not nbrDimensions(infArrays(x)) = 1 Then
                allArraysOK = False
                Exit For
            End If
            UBoundCount = UBoundCount + itemsInArray(infArrays(x))
        Next x
        If allArraysOK Then
            ReDim tmpArr(0 To UBoundCount - 1)
            UBoundCount = 0
            For x = LBound(infArrays) To UBound(infArrays)
                For y = LBound(infArrays(x)) To UBound(infArrays(x))
                    tmpArr(UBoundCount) = infArrays(x)(y)
                    UBoundCount = UBoundCount + 1
                Next y
            Next x
            newUBoundCount = itemsInArray(tmpArr)
            If newUBoundCount = UBoundCount Then
                mergeOneDimArrays = tmpArr
            Else
                mergeOneDimArrays = Array()
            End If
            Erase tmpArr
        Else
            mergeOneDimArrays = Array()
        End If

        End Function
Guest
  • 430
  • 2
  • 4
-1

If you are working with one-dimensional arrays you could use a collection instead. It is much better at handling dynamic sizing.

You can declare a collection and then add each of the elements in the arrays to it. Then you will have one large list with all of the values.

Dim coll As New Collection
coll.Add MyArray(j)

Here is a good to collections introduction: https://excelmacromastery.com/excel-vba-collections/

Franksta
  • 129
  • 9