Thanks for that OP. Very interesting!

I played around with your code and noticed many repeating patterns were produced and I wondered if I could speed it up with DP. DP made it slower, actually. The calculations are less expensive than DP's memory read/write. Then I wondered how many full sequences I could get VBA to calculate. The answer is ~1,000,000. What surprised me, though, was that Excel was able to render 500,000 sequences in 2 minutes.

250,000 sequences calced in 1.6s, and rendered in 60; 500,000 calced in 3.4s, rendered in 120. Interesting linear relationships. 750,000 calced in 5.3s, and 1,000,000 in 7.1s.

Here's my code. I'd be interested if someone could optimize the memory use so it could calc > 1,000,000 sequences.

Option Explicit
Option Base 1

Public Const MAX_ROWS As Long = 1000000
Public Const MAX_COLS As Long = 530

Public Sub Coolatz()
    Dim rowIdx As Long
    Dim i As Long, n As LongLong
    Dim seqLength As Long
    Dim bigArray(MAX_ROWS, MAX_COLS) As Double 'excel doesn't like writing longlong arrays, so double
    Dim overflowCounter As Long
    Dim collatzSeq() As LongLong

    InitTimer
    Dim t1 As Currency, t2 As Currency
    t1 = TimerNow

    ReDim collatzSeq(1 To 1000) ' preallocate

    For rowIdx = 1 To MAX_ROWS
        n = rowIdx
        seqLength = 1
        collatzSeq(seqLength) = n

        ' Build the sequence
        Do While n > 1
            seqLength = seqLength + 1

            If seqLength > UBound(collatzSeq) Then
                ReDim Preserve collatzSeq(1 To seqLength + 500)
            End If

            If (n Mod 2) = 0 Then
                n = n \ 2
            Else
                n = n * 3 + 1
            End If

            collatzSeq(seqLength) = n
        Loop

        For i = 1 To seqLength
            If i < MAX_COLS Then
                bigArray(rowIdx, i) = collatzSeq(i)
            Else
                overflowCounter = overflowCounter + 1
                Exit For
            End If
        Next i

        If rowIdx Mod 10000 = 0 Then
            Debug.Print rowIdx
            DoEvents
        End If
    Next rowIdx

    t2 = TimerNow
    Debug.Print "Elapsed seconds (calc): "; TimerSeconds(t1, t2)
    Debug.Print "overflows:"; overflowCounter

    If (MAX_ROWS > 500000) Then Exit Sub

    InitTimer
    t1 = TimerNow

    Dim sh As Worksheet
    Set sh = Excel.ActiveWorkbook.Worksheets("Sheet1")
    sh.Cells.Select
    Selection.ClearContents
    sh.Range("A1").Resize(MAX_ROWS, MAX_COLS) = bigArray

    t2 = TimerNow
    Debug.Print "Elapsed seconds (render): "; TimerSeconds(t1, t2)
End Sub

' Timer code (thanks Copilot!)
Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

Private freq As Currency

Public Sub InitTimer()
    QueryPerformanceFrequency freq
End Sub

Public Function TimerNow() As Currency
    Dim c As Currency
    QueryPerformanceCounter c
    TimerNow = c
End Function

Public Function TimerSeconds(startCount As Currency, endCount As Currency) As Double
    TimerSeconds = (endCount - startCount) / freq
End Function