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

I have a tab delimited 2-dimensional data (copied from another Excel file on a remote system) in clipboard, which contains about 20 columns and can contain any number of rows.

I want to read the data into a VBA array of arrays, where each sub-array represents the complete data of one column from the 2-D data in the clipboard. The objective is to paste the data into a local Excel file, which has some hidden columns, by skipping the hidden columns while pasting. I want to use the array of arrays approach, so that while pasting, I can assign a whole column sub-array to the Excel Range.

I declare an array of arrays for 20 columns:

Dim allColsData(20) As Variant

But I do not want to be declaring 20 variables for each sub-array column, which I need to dynamically resize as I add each row from clipboard into this array allColsData.

I am new to Excel VBA and need help on how to populate the array allColsData by dynamically resizing each sub array, without declaring 20 array variables.

My question is:

What is the syntax to resize each sub array of allColsData without declaring variable for each sub array?

I can manage the code for reading from the clipboard and parsing into a 2-D array, first by splitting based on new line and then splitting each line on tab character.

CodePudding user response：

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