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.
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