1

Suppose I have a VBA one dimension array (or dict or collection) with X values. I need to perform an action with these values in batches of Y.

So if X = 55 and Y = 25, I would need to loop 3 times:

  1. Pick values 1 to 25 and perform action
  2. Pick values 26 to 50 and perform action
  3. Pick last 5 values and perform action

Any ideas with good performance will be greatly appreciated :)

Edit:

I came up with the code below. It works although doesn't look very concise

Sub test()

Dim arr As Variant
Dim temparr As Variant
Dim sippno As Integer
Dim loopend As Integer
Dim loopstart As Integer
Dim batchsize As Integer
Dim i As Integer

'Storing main array with all values

arr = Sheet1.Range("A1:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value

'Setting count of values, batch size and starting step for loop

sippno = WorksheetFunction.CountA(arr)
loopstart = 1
batchsize = 10

Do Until sippno = 0

If sippno < batchsize Then
loopend = loopstart + sippno - 1
Else
loopend = loopstart + batchsize - 1
End If

ReDim temparr(loopstart To loopend)

For i = loopstart To loopend

temparr(i) = WorksheetFunction.Index(arr, i, 0)

sippno = sippno - 1

Next

loopstart = loopend + 1

'Action to be performed with batch of values stored in second array

Debug.Print WorksheetFunction.TextJoin(", ", True, temparr)

Loop

End Sub
wwhitman
  • 81
  • 8

3 Answers3

2
Option Explicit
Sub splice()

    Const batch = 10
   
    Dim data, ar()
    Dim lastrow As Long, n As Long, i As Long
    Dim j As Long, r As Long
   
    With Sheet1
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        data = .Range("A1:A" & lastrow).Value2
    End With
    i = Int(lastrow / batch)
   
    For n = 0 To i
        r = batch
        If n = i Then
            r = lastrow Mod batch
        End If
        If r > 0 Then
            ReDim ar(r - 1)
            For j = 1 To r
                ar(j - 1) = data(j + n * batch, 1)
            Next
            ' do something
            Debug.Print Join(ar, ",")
        End If
    Next
End Sub
CDP1802
  • 13,871
  • 2
  • 7
  • 17
2

Slicing via Application.Index()

Just for the sake of the art I demonstrate in this late post how to slice a 'vertical' array in one go into several 'flat' arrays in batches of e.g. 10 elements.

This approach benefits from the advanced rearranging features & pecularities of Application.Index() allowing to pass entire row/column number arrays as arguments; here suffices a vertical array of desired row numbers, e.g. by filtering only rows 11 to 20 via Application.Index(data, Evaluate("Row(11:20)"), 0). .. c.f. see section 2 a)

Further notes:

  • evaluating a tabular row formula is one quick way to get consecutive row numbers.
  • transposing the function result changes the array dimension to a 1-dim array
  • reducing the array boundaries by -1 via ReDim Preserve ar(0 To UBound(ar) - 1) produces a zero-based array (optional)
Option Explicit
Sub splice()
    Const batch = 10        ' act in units of 10 elements
    With Sheet1         
        '1) get data (1-based 2-dim array)
        Dim lastRow As Long
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Dim data: data = .Range("A1:A" & lastRow).Value2
        '2) slice
        Dim i As Long, nxt As Long, ar As Variant
        For i = 1 To UBound(data) Step batch
            nxt = Application.min(i + batch - 1, UBound(data))
            '2a) assign sliced data to 1- dim array (with optional redim to 0-base)
            With Application
                ar = .Transpose(.Index(data, Evaluate("row(" & i & ":" & nxt & ")")))
            End With
            'optional redimming to zero-base
            ReDim Preserve ar(0 To UBound(ar) - 1)  
            
            '2b) perform some action
            Debug.Print _
                "batch " & i \ batch + 1 & ": " & _
                "ar(" & LBound(ar) & " To " & UBound(ar) & ") ~~> " & _
                Join(ar, "|")
        Next
    End With
End Sub

Slicing a 'flat' 1-dim array

If, however you want to slice a 1-dim array, like e.g. dictionary keys, it suffices to transpose the data input: data = Application.Transpose(...)

T.M.
  • 9,436
  • 3
  • 33
  • 57
  • @wwhitman Fyi A similar question focusses on how to spread a flat array into columns at [Reading array onto cells](https://stackoverflow.com/questions/65293125/why-when-reading-my-array-onto-cells-in-vba-does-it-repeat-every-row/65327917#65327917) – T.M. Oct 24 '21 at 19:44
0

2d array because to lazy to encode 1d but same idea with 1d:

Sub test()
    arr = Sheet3.Range("A1").CurrentRegion.Value2
    x = UBound(arr)
    y = 5
    jj = y
    
    For j = 1 To UBound(arr)
        sumaction = sumaction + arr(j, 1)
        If (UBound(arr) - jj) < 0 Then
            jj = UBound(arr)
            sumaction = 0
        End If
        If j = jj Then
            dosomething = sumaction * 2
            sumaction = 0
            jj = jj + y
        End If
    Next j
End Sub
ceci
  • 589
  • 4
  • 14