Kamui
Kamui

Reputation: 799

Is it possible to extend the length of an existing array based on values collected from other arrays?

Let's say I have a couple arrays such as:

array(0) = (a, b, d, e)
array(1) = (c, e, g)
array(2) = (a, c, f, g, h)

Which all have some values in common.

I want to extend the length of these arrays to look like:

(a, b, , d, e, , , )
( , , c, , e, , g, )
(a, , c, , , f, , h)

Basically, I want to make sure all arrays are the same length and that the values will align across each element.

How can I do this with vba code?

I was thinking I would create a collection that stores unique values and ReDimension the existing arrays or create new arrays to mirror the existing one based on the length of the collection. But I don't know how to move the array elements accordingly.

Thanks!

Upvotes: 0

Views: 52

Answers (1)

JNevill
JNevill

Reputation: 50064

Here's a very clunky cobbled together chunk of code to pull this off. This could definitely use some refactoring, but I think the the overall concept is the right route. Plus this will work for any elements you want to stick into those inner-arrays which is kind of cool.

Sub padArrays()

    'Input from question
    Dim arr As Variant
    ReDim arr(0 To 2)
    arr(0) = Array("a", "b", "d", "e")
    arr(1) = Array("c", "e", "g")
    arr(2) = Array("a", "c", "f", "g", "h")

    'Get a dictionary (add reference to Microsoft.Scripting)
    Dim arrDict As Scripting.Dictionary
    Set arrDict = New Dictionary

    'Fill dictionary with distinct values from all inner arrays
    'Just using the dictionary to get distinct values here since
    'that's uglier to do with pure arrays
    For Each singleArray In arr
        For Each singleItem In singleArray
            If Not arrDict.Exists(singleItem) Then arrDict.Add singleItem, Empty
        Next
    Next

    'Switch back to array just so we can sort (surely there is a better way)
    Dim distinctArr As Variant
    ReDim distinctArr(0 To arrDict.Count - 1)
    Dim arrCounter As Integer: arrCounter = 0
    For Each dictItem In arrDict
        distinctArr(arrCounter) = dictItem
        arrCounter = arrCounter + 1
    Next

    'Sort the array
    QuickSort distinctArr, 0, UBound(distinctArr)

    'Back out to a dictionary that has the item as key and the position/index as value
    'We can use this when building our desired output
    Dim sortDict As Dictionary
    Set sortDict = New Dictionary
    For distinctIndex = 0 To UBound(distinctArr)
        sortDict.Add distinctArr(distinctIndex), distinctIndex
    Next

    'create a new version of original array, dimensioned appropriately
    Dim outArr As Variant
    ReDim outArr(0 To UBound(arr), 0 To UBound(distinctArr))

    'Loop once again through original multi-dim array but stick everything where it belongs
    Dim dim1 As Integer: dim1 = 0
    For Each singleArray In arr
        For Each singleItem In singleArray
            'The key of sortDict dictionary is the item and the value of the dictionary entry has the position
            'So we only need grab the dictionary entry for the `singleItem` to know
            'which index to stick this thing
            outArr(dim1, sortDict(singleItem)) = singleItem
        Next
        dim1 = dim1 + 1
    Next

    Stop 'our outArr will have everything where you want it, check the locals window. 

End Sub

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
  'stolen from https://stackoverflow.com/questions/152319/vba-array-sort-function
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub

In short this is:

  1. Getting a distinct list of all values from your arrays
  2. Sorting that list so we can determine ordinal
  3. Storing that list and corresponding ordinals in a dictionary
  4. Generating a new array of arrays, correctly dimensioned
  5. Sticking everything from the original arrays into their correct position according to the dictionary entries.

Upvotes: 1

Related Questions