0

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!

BigBen
  • 46,229
  • 7
  • 24
  • 40
Kamui
  • 719
  • 1
  • 9
  • 16
  • `ReDim` can only resize the first dimension of a multidimensional array. You'll have to copy the arrays into a new, appropriately-sized one. – Mathieu Guindon Nov 08 '19 at 21:01
  • ReDim resizes the second dimension only I believe? – Kamui Nov 08 '19 at 21:01
  • Does it (it's either the first or the last)? Feel free to try it! I don't use `ReDim` very often, because resizing arrays isn't something that's efficiently done. If you don't know how many items you're going to need up-front, use a `Collection`, not an array. I die a little inside everytime I see `ReDim foo(UBound(foo) + 1)` in a loop. – Mathieu Guindon Nov 08 '19 at 21:02
  • Yeah I've been constantly ReDimming my arrays in loops because I don't know how large they will be in advance. :( So in these instances I should use a collection and then when I'm done loop through that instead? – Kamui Nov 08 '19 at 21:04
  • 2
    I think rediming is the least of the problems to solve here. – JNevill Nov 08 '19 at 21:04
  • Consider how [VBA-JSON](https://github.com/VBA-tools/VBA-JSON) yields JSON objects: nested dictionaries and fixed-size arrays. FWIW the name `array`, if legal, is hiding the standard library `Array` function - consider using any other name. – Mathieu Guindon Nov 08 '19 at 21:07
  • Is it required only that items line up, or that they're also sorted, as in your example? Does each sub-array contain only unique items? – Tim Williams Nov 08 '19 at 21:40

1 Answers1

1

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.
JNevill
  • 46,980
  • 4
  • 38
  • 63