2

I'm trying to create 3 sublists from the main list itemlist, but I can't find any way to achieve that. I've found a solution in python when I check out this link.

Sub CreateSubList()
    Dim itemlist As Variant, itemNum As Variant
    Dim oSublist As Variant
    
    itemlist = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")
    
    'here I was expecting to create a variable holding sublist, as in oSublist which contains Array("1", "2", "3", "4")
    'Array("5", "6", "7", "8") and Array("9", "10", "11") in each loop
    'and finally iterate over the list in chunk to print the result
    
    For Each itemNum In oSublist
        Debug.Print itemNum
    Next itemNum
End Sub

To be specific, I'm trying to mimic this in vba:

itemlist = ["1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11"]

for i in range(0, len(itemlist), 4):
    chunk = itemlist[i:i + 4]
    
    for n in chunk:
        print(n)

It seems I'm very close to solve the issue.

Sub CreateSubList()
    Dim itemlist As Variant, itemNum As Variant
    Dim oSublist As Variant, iCol As Collection
    Dim inum As Variant
    
    Set iCol = New Collection

    itemlist = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")

    For Each inum In itemlist
        iCol.Add inum
        
        If iCol.Count >= 3 Then
            For Each itemNum In iCol
                Debug.Print itemNum
            Next itemNum
            
            Debug.Print "---------------------"
            Set iCol = Nothing
            Set iCol = New Collection
        End If
    Next inum
End Sub

Output I'm getting:

1
2
3
---------------------
4
5
6
---------------------
7
8
9
---------------------

However, what is still unresolved is I can't capture the two items, as in 10 and 11 conditionally from the itemlist.

Zoe
  • 27,060
  • 21
  • 118
  • 148
MITHU
  • 113
  • 3
  • 12
  • 41

3 Answers3

5

Option 1 - using a jagged array

CreateSubLists() returns a jagged array Array(Array(), Array(), ...) from the sliced elements of the original array.

Option Explicit

Function CreateSubLists(itemlist, count)
    Dim amount, chunks, i, j, retval, a
    amount = UBound(itemlist) - LBound(itemlist) + 1        'get the amount of the elements
    chunks = WorksheetFunction.RoundUp(amount / count, 0)   'calculate the number of chunks (e.g. if 2.5 then 3)
    
    ReDim retval(0 To chunks - 1)   'make the outer array
    For i = 0 To UBound(retval)
        'make the inner array. If the rest of the itemlist is less then chunk then get the size of the rest
        ReDim a(0 To WorksheetFunction.Min(count - 1, amount - i * count - 1))
        For j = 0 To UBound(a)
            a(j) = itemlist(i * count + j)  'fill the inner array
        Next
        retval(i) = a   'place the inner array into the outer array
    Next
    CreateSubLists = retval 'return the jagged array
End Function

Sub Example()
    Dim itemlist, chunk
    itemlist = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")
    For Each chunk In CreateSubLists(itemlist, 4)  ' works with any positive integer number
        Debug.Print "[" & Join(chunk, ",") & "]"
    Next
End Sub

Option 2 - using Collection

Function CreateSubLists2(itemlist, count) As Collection
    Dim amount, chunks, i, j, a
    amount = UBound(itemlist) - LBound(itemlist) + 1        'get the amount of the elements
    chunks = WorksheetFunction.RoundUp(amount / count, 0)   'calculate the number of chunks (e.g. if 2.5 then 3)
    
    Dim retval As New Collection   'make the outer collection
    For i = 0 To chunks - 1
        'make the inner array. If the rest of the itemlist is less then chunk then get the size of the rest
        Set a = New Collection
        For j = 0 To WorksheetFunction.Min(count - 1, amount - i * count - 1)
            a.Add itemlist(i * count + j)  'fill the inner collection
        Next
        retval.Add a   'place the inner collection into the outer collection
    Next
    Set CreateSubLists2 = retval 'return the collection of collections
End Function

Sub Example2()
    Dim itemlist, chunk, el, s
    itemlist = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")
    For Each chunk In CreateSubLists2(itemlist, 4)  ' works with any positive integer number
        s = "["
        For Each el In chunk
            s = s & el & ","
        Next
        s = s & "]"
        Debug.Print Replace(s, ",]", "]")
    Next
End Sub

Prints:

[1,2,3,4]
[5,6,7,8]
[9,10,11]
Алексей Р
  • 7,507
  • 2
  • 7
  • 18
  • So, it's possible to create sublists dynamically in vba. This is the best example I've come across so far. Thanks. – MITHU Jul 26 '21 at 07:30
  • Upvoting for Option 1. I'm guessing @MITHU likes `Redim` – S Meaden Jul 26 '21 at 09:18
  • In option 1, the sublist array will always have the same length maybe except the last iteration. I would ```ReDim``` just once before the loop and a second time, only if needed, for the last sublist. Upvoted. – Cristian Buse Jul 26 '21 at 15:56
  • I would also add some checks for the input arguments. Like checking if the ```itemList``` is indeed a 1D array and if ```count``` is larger than 0. Marking the input parameters ```ByVal``` would not hurt either as well as declaring their data type. – Cristian Buse Jul 26 '21 at 15:59
  • Actually, the ```itemList``` parameter would be better declared ```ByRef``` to avoid VBA making a copy of the whole array. – Cristian Buse Jul 26 '21 at 16:05
2

I see you're using a VBA.Collection as the vessel in which to store you sublists (slices). I prefer to use the Scripting.Dictionary which can be accessed via the Tools->References menu selecting "Microsoft Scripting Runtime" (the file is location as c:\windows\system32\scrrun.dll"

I like to use the Scripting.Dictionary to arbitrarily build arrays in code because the Items method returns an array. So I can just pass this array to something like VBA.Join. Note how I use the Dictionary's count as a unique key (neat little trick), this turns it into something very similar to a Collection.

Also I have hived off the slice print logic to separate subroutine to avoid duplication. You need to call both inside the loop and after the loop.

Sub TestSimonsCreateSubList()
    Dim itemlist As Variant
    itemlist = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")
    SimonsCreateSubList itemlist, 3
    SimonsCreateSubList itemlist, 4
    SimonsCreateSubList itemlist, 5

End Sub

Sub SimonsCreateSubList(itemlist As Variant, lSliceLen As Long)
    
    Dim inum As Variant
    
    '* Tools->References-> Microsoft Scripting Runtime (c:\windows\system32\scrrun.dll)
    Dim dicSlice As Scripting.Dictionary
    Set dicSlice = New Scripting.Dictionary

    For Each inum In itemlist
        dicSlice.Add dicSlice.Count, inum
        
        If dicSlice.Count = lSliceLen Then
            PrintSlice dicSlice
            Set dicSlice = New Scripting.Dictionary
        End If
        
    Next inum
    PrintSlice dicSlice '* don't forget to print the tail end.
End Sub

Sub PrintSlice(dicSlice As Scripting.Dictionary)
    Debug.Print VBA.Join(dicSlice.Items, vbNewLine)
    Debug.Print "---------------------"
End Sub
S Meaden
  • 8,050
  • 3
  • 34
  • 65
1

I do not have access to Microsoft Office or VBA at the moment but used to be quite proficient with it and wrote this just using reference on syntax from memory. I have not tested it but am pretty sure it will work, feel free to make modifications if there are syntax errors but should be pretty close.

Edit - Applied edits suggested below, I assume it works now.

' Pass chunkLength, must be smaller than length of list
Sub SubLists(chunkLength As Long)
    Dim myList As Variant
    myList = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)

    ' Length of myList divide this by chunkLength to see 
    '   how many rows output 2-dimensional array will have
    Dim listLength As Long
    listLength = UBound(myList)

    ' arrayRows is the number of rows needed in output array
    Dim arrayRows as Long
    arrayRows = -Int(-listLength / chunkLength)

    ' If we use your example of chunks of 3, this is an array (4, 3)
    ' This array has 3 subarrays with 3 elements and 1 with 2 elements
    Dim subLists() As Variant
    ' chunkLength needs to be >1 or next line is a problem
    ReDim subLists(0 To arrayRows - 1, 0 To chunkLength - 1)

    ' row index into 2-dimensional array
    Dim row As Long
    row = 0

    ' column index into 2-dimensional array
    Dim itemIndex As Long
    itemIndex = 0

    ' just a counter
    Dim listIndex As Long
    For listIndex = 0 to (listLength - 1)
        subLists(row, itemIndex) = myList(listIndex)
        If (itemIndex < chunkLength - 1) Then
            itemIndex = itemIndex + 1
        Else
            itemIndex = 0
            row = row + 1
        End If
    Next listIndex
End Sub

Notes above assume that chunks are of size 3, as in the example that you linked to, but I think this code has the desired behavior. You can pass in any chunk length that is shorter than the length of the list (but more than one - see comment in code). You could also pass in an empty array to the Sub (as a 2nd parameter, though you'd need to define your starting list and array dimensions in the calling function), so that it can be used in the calling function to access the array externally, but you would need to pass it ByRef to be able to modify it in the Sub.

Steve Williams
  • 128
  • 1
  • 7
  • 3
    The code does not compile but considering it's from memory here is what you need to change: 1) replace ```Roundup(listlength/chunkLength)``` with ```-Int(-listLength / chunkLength)```; 2) replace ```Dim subLists(arrayRows, chunkLength) As Variant``` with ```Dim subLists() As Variant: ReDim subLists(0 To arrayRows - 1, 0 To chunkLength - 1)```; 3) replace all ```As Integer``` with ```As Long``` as behind the scenes VBA uses Long anyway. – Cristian Buse Jul 26 '21 at 15:51
  • @CristianBuse I applied your fixes with one minor change in part 1. You need to add .5 because I want it to round up (say listLength is 10 and chunkLength is 4, that's 2.5, int(2.5) is 2 - adding 0.5 provides the proper offset). Also took out the double -, which I didn't understand and didn't seem necessary. Thanks for looking it over, I haven't done VBA in a decade and not seriously in almost 2. – Steve Williams Jul 26 '21 at 22:05
  • Actually that is not right either, the offset... If listLength was 12 and chunkLength 5, that gives 2.4 + 0.5 =2.9, int(2.9) = 2, where I obviously need 3. Will change that as well in a sec - if it has a modulus (remainder after division), then can just do int(listLength/chunkLength) + 1 – Steve Williams Jul 26 '21 at 22:49
  • @CristianBuse Another question, by your comments above about replacing all Int with Long, why do you suggest the Int function here? Is there a Long equivalent? – Steve Williams Jul 26 '21 at 22:57
  • 1
    The ```Int``` function operates on both the ```Integer``` and ```Long``` data types. The ```Int``` function is actually a RoundDown function. Using ```Int``` on 2.1 or 2.9 returns 2 for both and using ```Int``` on -2.1 and -2.9 returns -3 on both. So, using ```Int``` we can round down a given ```x``` variable with ```Int(x)``` and we can round up using ```-Int(-x)```. Hence, there is never a need for the offset you mentioned above. Your original idea was sound and because there simply is no built-in RoundUp function in VBA, I suggested a replacement. – Cristian Buse Jul 27 '21 at 07:53
  • 1
    @CristianBuse Thanks for the explanation. Interesting technique on rounding down as a negative number, I changed the line back to what you suggested as it's superior. – Steve Williams Jul 27 '21 at 10:29