VBA - Fast Serialization of Cells to Array Literal String

Today on StackOverflow I saw a great answer which utilizes Mid$() as a left hand operator to write into a string buffer. Concatenating strings is always slow and this is why languages such as C# and Java have a StringBuilder class. Using Mid$() on the left hand side of an assignment is VBA's equivalent of StringBuilder.

We can use this Mid$ (StringBuilder) to very quickly serialize a block of cells to an array literal which can be used to save fragments to file or for marshalling across to a web service

As a reminder array literal strings can be passed to Application.Evaluate and so parsed into an array ready to be pasted to cells. They are quite a simple format, the columns are comma separated and the rows semi-colon sepated, strings are quoted and the whole block is wrapped into curly brackets thus ...

Sub IllustratingApplicationEvaluateAndLiterals()
    
    Dim v As Variant
    v = Application.Evaluate("{""a"",""b"",3;""d"",5.1,""f""}")
    
    Debug.Assert v(1, 1) = "a"
    Debug.Assert v(1, 2) = "b"
    Debug.Assert v(1, 3) = 3
    Debug.Assert v(2, 1) = "d"
    Debug.Assert v(2, 2) = 5.1
    Debug.Assert v(2, 3) = "f"
    
End Sub

So now some code to take cells and serialize into an array literal string

Function GetRangeLiteral(ByVal rngSource As Excel.Range)
    Const CELL_LENGTH = 257 'Add 2 for double quotes
    
    With rngSource
        Dim lRows As Long
        lRows = .Rows.Count
        
        Dim lColumns As Long
        lColumns = .Columns.Count
        
        Dim lBufferSize As Long
        lBufferSize = CELL_LENGTH * .Cells.Count + lRows + (lRows * lColumns)
    End With
    
    '* initialise the buffer with spaces then start opening brace
    Dim sText As String
    sText = VBA.Space(lBufferSize)
    Mid$(sText, 1, 1) = "{"
    
    Dim lCursor As Long
    lCursor = 1
    
    Dim vData()
    vData = rngSource.Value

    Dim lRow As Long
    For lRow = 1 To lRows
    
        '* if past first row then we need a row continuation
        If lRow > 1 Then
            lCursor = lCursor + 1
            Mid$(sText, lCursor, 1) = ";"
        End If

        Dim lColumn As Long
        For lColumn = 1 To lColumns
            
            Dim vCell As Variant
            vCell = vData(lRow, lColumn)
            
            Dim lCellLength As Long
            lCellLength = Len(vCell)
            
            '* extend buffer if necessary
            If lCursor + lCellLength + 2 > Len(sText) Then sText = sText & Space(CDbl(lBufferSize / 4))
            
            '* if past first column then we need a cell continuation
            If lColumn > 1 Then
                lCursor = lCursor + 1
                Mid(sText, lCursor, 1) = ","
            End If

    
            '* write in value directly into buffer, wrap quotes around strings
            If (VBA.TypeName(vCell) = "String") Then
                lCellLength = lCellLength + 2
                Mid$(sText, lCursor + 1, lCellLength) = """" & vCell & """"
            Else
                Mid$(sText, lCursor + 1, lCellLength) = vCell
            End If
            
            '* increment cursor
            lCursor = lCursor + lCellLength
        Next
    Next

    GetRangeLiteral = Left$(sText, lCursor) & "}"
End Function

Function TestGetRangeLiteral()
    
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(4).Range("c3:e4")
    rng.Cells(1, 1) = "a"
    rng.Cells(1, 2) = "b"
    rng.Cells(1, 3) = 3
    rng.Cells(2, 1) = "d"
    rng.Cells(2, 2) = 5.1
    rng.Cells(2, 3) = "f"
    
    Dim sRange As String
    sRange = GetRangeLiteral(rng)
    
    Debug.Assert sRange = "{""a"",""b"",3;""d"",5.1,""f""}"
    
    Dim v As Variant
    v = Application.Evaluate(sRange)
    Debug.Assert v(1, 1) = "a"
    Debug.Assert v(1, 2) = "b"
    Debug.Assert v(1, 3) = 3
    Debug.Assert v(2, 1) = "d"
    Debug.Assert v(2, 2) = 5.1
    Debug.Assert v(2, 3) = "f"
    
End Function