Private Sub ReDimVerify()

    Dim S() As String * 4096
    ReDim S(1 To 30)

    Dim intX As Integer

    intX = 1
    Do While intX <= 2048
        Debug.Print "ReDim S(1 To " & intX & ") (" & 4096# * intX & " bytes.)"
        DebugTimerOn
        ReDim S(1 To intX)
        Debug.Print DebugTimerOff

        intX = intX * 2
    Loop

    intX = 1
    Do While intX <= 2048
        Debug.Print "ReDim Preserve S(1 To " & intX & ") (" & 4096# * intX & " bytes.)"
        DebugTimerOn
        ReDim Preserve S(1 To intX)
        Debug.Print DebugTimerOff

        intX = intX * 2
    Loop
End Sub