Excel VBA: Resize sub arrays within an array of arrays without declaring variable for each sub array

Jag Clipboard Columns

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Tests the JagClipBoardColumns function.
' Calls:        JagClipBoardColumns
'                   RefColumn,GetRange.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub JagClipBoardColumnsTEST()
    
    Dim cData As Variant: cData = JagClipBoardColumns
    If IsEmpty(cData) Then Exit Sub
    
    Dim c As Long
    
    For c = 1 To UBound(cData)
        Debug.Print "Array " & c & " has " & UBound(cData(c)) & " rows."
    Next c

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Adds a new one-worksheet workbook and pastes the contents
'               of the clipboard starting with cell 'A1'. Returns the values
'               of each column from a given row ('FirstRow') to the bottom-most
'               non-empty row in a 2D one-based array of a jagged array
'               finally closing the workbook.
' Calls:        RefColumn,GetRange.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function JagClipboardColumns( _
    Optional ByVal FirstRow As Long = 1) _
As Variant
    Const ProcName As String = "JagClipboardColumns"
    On Error GoTo ClearError
    
    Application.ScreenUpdating = False
    
    Dim wb As Workbook: Set wb = Workbooks.Add(xlWBATWorksheet) ' one worksheet
    Dim ws As Worksheet: Set ws = wb.Worksheets(1)
    
    ws.PasteSpecial Format:="Unicode Text"
    
    Dim rg As Range: Set rg = ws.UsedRange
    
    Dim cCount As Long: cCount = rg.Columns.Count
    Dim cData As Variant: ReDim cData(1 To cCount)
    
    Dim crg As Range
    Dim c As Long
    
    For c = 1 To cCount
        Set crg = RefColumn(ws.Cells(FirstRow, c))
        cData(c) = GetRange(crg)
    Next c
        
    wb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True

    JagClipboardColumns = cData

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the one-column range from the first cell
'               of a range ('FirstCell') to the bottom-most non-empty cell
'               of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
    ByVal FirstCell As Range) _
As Range
    Const ProcName As String = "RefColumn"
    On Error GoTo ClearError
    
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row + 1)
    End With

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values of a range ('rg') in a 2D one-based array.
' Remarks:      If ˙rg` refers to a multi-range, only its first area
'               is considered.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRange( _
    ByVal rg As Range) _
As Variant
    Const ProcName As String = "GetRange"
    On Error GoTo ClearError
    
    If rg.Rows.Count + rg.Columns.Count = 2 Then ' one cell
        Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        GetRange = Data
    Else ' multiple cells
        GetRange = rg.Value
    End If

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function