Search code examples
excelvbajagged-arrays

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


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.


Solution

  • 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