Best workaround for VBA Transpose array length limit?

Question

After running a simulation with 100,000 iterations, I tried to dump the values from each iteration into a column. Here is the gist of the code:

Sub test()
Application.ScreenUpdating = False
Dim totalgoals() As Variant, ko As Worksheet, out As Worksheet, iter As Long
Set ko = Sheets("KO Sim")
Set out = Sheets("Monte Carlo")
iter = out.Range("P2").Value
For i = 1 To iter
    ko.Calculate
    If i = 1 Then
        ReDim totalgoals(1 To 1, 1 To 1) As Variant
        totalgoals(1, 1) = ko.Range("F23").Value
    Else
        ReDim Preserve totalgoals(1 To 1, 1 To i) As Variant
        totalgoals(1, i) = ko.Range("F23").Value
    End If
Next i
out.Range("U1:U" & iter) = Application.WorksheetFunction.Transpose(totalgoals)
Application.ScreenUpdating = True
End Sub

This throws a Type Mismatch error on the next to last line because Transpose can only handle arrays of length up to 2^16 (~64,000). So, how should I workaround this? What is my most efficient option?

I set up my code to store the values in an array just for the easy output, but it seems that's not going to work for this many values. Would I be better off sticking with arrays and just write my own transpose function (i.e., loop through the array and write the values to a new array), or would I be better off working with a different class from the start, like a collection, if I'm just going to have to loop through the results in the end anyway?

Or better yet, is there anyway to do this without having to loop through the values again?

EDIT:

I provided a bad example because the ReDim Preserve calls were unnecessary. So, consider the following instead where they are necessary.

ReDim totalgoals(1 To 1, 1 To 1) As Variant
For i = 1 To iter
    ko.Calculate
    If ko.Range("F23") > 100 Then
        If totalgoals(1, 1) = Empty Then
            totalgoals(1, 1) = ko.Range("F23").Value
        Else
            ReDim Preserve totalgoals(1 To 1, 1 To UBound(totalgoals, 2) + 1) As Variant
            totalgoals(1, UBound(totalgoals, 2)) = ko.Range("F23").Value
        End If
    End If
Next i
out.Range("U1").Resize(UBound(totalgoals, 2),1) = Application.WorksheetFunction.Transpose(totalgoals)

Also, looping in VBA is pretty fast. Interacting with Excel from VBA is not. So as long as you are just doing VBA stuff, re-looping shouldn't be a problem. — RBarryYoung, Nov 18 '13 at 19:16

Chel · Answer 1 · 2013-11-18T22:29:51.370

5

Calculation is definitely going to be the bottleneck here, so (as RBarryYoung says) transposing the array entry-by-entry won't really affect the speed at which your macro runs.

That said, there is a way to transpose a 2D row to a column (and vice versa) in constant time:

Private Declare Function VarPtrArray Lib "msvbvm60" Alias _
    "VarPtr" (ByRef Var() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60.dll" (src As Any, dest As Any)
Private Declare Sub GetMem8 Lib "msvbvm60.dll" (src As Any, dest As Any)

Sub test()
    Dim totalgoals() As Single
    Dim f As Single
    Dim i As Long, iter As Long

    'dimension totalgoals() with as many cells as we
    'could possibly need, then cut out the excess
    iter = 100000
    ReDim totalgoals(1 To 1, 1 To iter)
    For iter = iter To 1 Step -1
        f = Rnd
        If f > 0.2 Then
            i = i + 1
            totalgoals(1, i) = f
        End If
    Next iter
    ReDim Preserve totalgoals(1 To 1, 1 To i)

    'transpose by swapping array bounds in memory
    Dim u As Currency
    GetMem8 ByVal VarPtrArray(totalgoals) + 16, u
    GetMem8 ByVal VarPtrArray(totalgoals) + 24, _
            ByVal VarPtrArray(totalgoals) + 16
    GetMem8 u, ByVal VarPtrArray(totalgoals) + 24
End Sub

edited Nov 18 '13 at 22:29

answered Nov 18 '13 at 22:23

Chel

2,593
1
18
24

I'm pretty sure you wont respond, but just in case: you declare both GetMem4 & GetMem8, but in the code below you only use GetMem8. How so? – Peter L. Jun 09 '15 at 18:56
I had used it in a previous version and just forgot to remove it. – Chel Jun 12 '15 at 02:21
Is there a version of this for Win64? – Nigel Heffernan Jan 24 '18 at 10:55
@NigelHeffernan Put Private Declare PtrSafe Function – QHarr Feb 02 '18 at 09:56
@Chel Mind telling me if your solution to transpose "in constant time" could work with a scripting dictionnary? Could not find any relevant doc on GetMem8. Thanks! – Lo Bellin Apr 17 '18 at 12:59

RBarryYoung · Accepted Answer · 2013-11-21T19:27:03.247

Here's a version of your code that should work and be faster:

Sub test()
Application.ScreenUpdating = False
Dim totalgoals() As Variant, ko As Worksheet, out As Worksheet, iter As Long
Set ko = Sheets("KO Sim")
Set out = Sheets("Monte Carlo")
iter = out.Range("P2").Value

' ReDim it completely first, already transposed:
ReDim totalgoals(1 To iter, 1 To 1) As Variant

For i = 1 To iter
    ko.Calculate
    totalgoals(i, 1) = ko.Range("F23").Value
Next i
out.Range("U1:U" & iter) = totalgoals
Application.ScreenUpdating = True
End Sub

Here's a version that keeps the conditional ReDims, but manually transposes the array at the end:

Sub test()
Application.ScreenUpdating = False
Dim totalgoals() As Variant, ko As Worksheet, out As Worksheet, iter As Long
Set ko = Sheets("KO Sim")
Set out = Sheets("Monte Carlo")
iter = out.Range("P2").Value
For i = 1 To iter
    ko.Calculate
    If i = 1 Then
        ReDim totalgoals(1 To 1, 1 To 1) As Variant
        totalgoals(1, 1) = ko.Range("F23").Value
    Else
        ReDim Preserve totalgoals(1 To 1, 1 To i) As Variant
        totalgoals(1, i) = ko.Range("F23").Value
    End If
Next i
' manually transpose it
Dim trans() As Variant
ReDim trans(1 to UBound(totalgoals), 1 to 1)
For i = 1 to UBound(totalgoals)
    trans(i, 1) = totalgoals(1, i)
Next i
out.Range("U1:U" & iter) = trans
Application.ScreenUpdating = True
End Sub

Of course. Thanks. I should have made my example actually require the ReDim Preserve steps -- say if I only wanted to tally the value if it met a certain condition, and I didn't know how many values I would end up with. Would you recommend sticking with arrays in that case? — Excellll, Nov 18 '13 at 19:19
@Excellll , VBA arrays are very fast. If you have to do it that way, then just transpose it yourself in VBA at the end. i.e., make another array with the transposed dimensions and copy totalgoals into it one element at a time, and then paste *that* array into Excel. I have added an example in my answer. — RBarryYoung, Nov 18 '13 at 19:27

Mark E. · Answer 3 · 2022-08-18T17:36:50.193

Transpose Arrays by Loop
This function will transpose a 1d or 2d array without many of the limitations of Application.Transpose (type changes, errors, length limits).

The function will error if the array holds an object, like Application.Transpose does. The basic problem here is that moving an object from one array to another requires the Set keyword, and testing VarTypes to find objects has a cost. Most arrays being transposed probably don't have objects, anyway.

Function ArrayTranspose(sourceArray As Variant) as Variant
'Transpose a 1d or 2d array not containing objects
'A 1d array (interpreted as a row in Excel) will become 2d, but not vice versa

    'Get the number of dimensions
    Dim dimCount As Long
    On Error Resume Next 'An error is standard to give the # of dimensions
        For dimCount = 0 To 2
            If IsEmpty(UBound(sourceArray, dimCount + 1)) Then Exit For
        Next
    On Error GoTo 0

    Dim returnArray() As Variant
    Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
    Dim i As Long, j As Long
    
    If dimCount = 1 Then
        LB1 = LBound(sourceArray, 1): UB1 = UBound(sourceArray, 1)
        LB2 = LB1: UB2 = LB1 'In converting to 2d, use lBound of first dimension as lBound of second
        ReDim returnArray(LB2 To UB2, LB1 To UB1)
        For i = LB1 To UB1
            returnArray(LB2, i) = sourceArray(i)
        Next
    ElseIf dimCount = 2 Then
        LB1 = LBound(sourceArray, 1): UB1 = UBound(sourceArray, 1)
        LB2 = LBound(sourceArray, 2): UB2 = UBound(sourceArray, 2)
        ReDim returnArray(LB2 To UB2, LB1 To UB1)
        For i = LB1 To UB1
            For j = LB2 To UB2
                returnArray(j, i) = sourceArray(i, j)
            Next
        Next
    Else 'Input was not a usable 1d or 2d array; return an empty array
        returnArray = Array()
    End If
      
    ArrayTranspose = returnArray
End Function

Best workaround for VBA Transpose array length limit?

3 Answers3

Linked

Related