Best solution for limiting VBA Transpose array length?

Question

After starting the simulation with 100,000 iterations, I tried to derive 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 causes a type mismatch error on the next line, because Transpose can handle arrays up to 2 ^ 16 (~ 64,000) long. So how do I solve this? What is my most effective option?

I set my code to store values ​​in an array just for simple output, but it doesn't seem to work for these many values. Will it be better to stick with arrays and just write my own transpose function (i.e., iterate over the array and write the values ​​to a new array), or will I be better off working with another class from the very beginning, for example, with a collection, if I still have to punching results all the time?

Or even better, is there anyway to do this without iterating over the values ​​again?

EDIT:

I presented a bad example, because ReDim Preserve calls are not needed. So, consider the following, where they are needed.

 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) 

Answer 1

Here is 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 retains conditional ReDims, but manually wraps 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 

Answer 2

Computing will definitely be the bottleneck here, so (as RBarryYoung says) moving the array in by input does not affect the speed at which your macro runs.

However, there is a way to move a two-dimensional row into 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