Copy a given column of a VBA 2D array to a worksheet column

Question

I'm importing a table from a Tab-separated text file. I'm only interested in certain columns, so this is what I'm trying to do:

No problem: Read entire file into one long string

No problem: Split long string into rows, along vbCrlf

No problem: split each row into cells, along vbTab. Put those values into a 2d array

Problem: Sheets("Sheet2").Range("A:A") = Matrix (only a selected column)

I need help to find the syntax how to address e.g. the 5th column of the matrix, all rows.

Did I make myself clear?

Open Filename For Binary As #1

MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
Debug.Print strData(1)

Dim Matrix() As String
Dim Fields() As String
Fields = Split(strData(0), vbTab)
Dim Rader As Long
Dim Kolumner As Long
ReDim Matrix(UBound(strData), UBound(Fields))
For Rader = 0 To UBound(strData)
    Fields() = Split(strData(Rader), vbTab)
    For Kolumner = 0 To UBound(Fields)
        Matrix(Rader, Kolumner) = Fields(Kolumner)
    Next Kolumner
Next Rader
Sheets("Sheet2").Range("A:A") = Matrix 'that gets me the first column. How to pick another matrix column?

create another 2d array with only one column and while you are loading the larger on load the second with just the data desired. — Scott Craner, Jul 02 '20 at 22:00
see here: https://stackoverflow.com/questions/48598247/slice-array-to-use-index-on-larger-than-65000 — Scott Craner, Jul 02 '20 at 22:03

VBasic2008 · Accepted Answer · 2021-01-30T14:15:51.693

Write Only Specified Columns From Array to Worksheet

Adjust the constants including the workbook and DataColumns.
The first Sub writes the columns specified in DataColumns to a worksheet.
The second Sub writes all columns to the worksheet.
The rest is being called.
ByRef (not necessary) is used to point out that values are being modified in the referred variable.

The Code

Option Explicit

Sub writeColumns()
    
    ' Text
    Const FilePath As String = "G:\Data\Baby Names\yob2018.txt"
    Const LineDelimiter As String = vbCrLf
    Const FieldDelimiter As String = ","
    
    ' Worksheet
    Const wsId As Variant = "Sheet1"
    Const FirstCell As String = "A1"
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim DataColumns() As Variant: DataColumns = Array(3, 1)
    
    ' Write from Text File to Data Array.
    Dim Data() As String
    getTextToArray Data, FilePath, LineDelimiter, FieldDelimiter
 
    ' Write from Data Array to Columns Array.
    Dim Cols() As Variant: Cols = getColumns(Data, DataColumns)
    
    ' Write from Columns Array to Columns Range.
    writeWorksheet Cols, wb, wsId, FirstCell

End Sub

Sub writeAll()
    
    ' Text
    Const FilePath As String = "G:\Data\Baby Names\yob2018.txt"
    Const LineDelimiter As String = vbCrLf
    Const FieldDelimiter As String = ","
    
    ' Worksheet
    Const wsId As Variant = "Sheet1"
    Const FirstCell As String = "A1"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Write from Text File to Data Array.
    Dim Data() As String
    getTextToArray Data, FilePath, LineDelimiter, FieldDelimiter

    ' Write from Data Array to Data Range.
    writeWorksheet Data, wb, wsId, FirstCell

End Sub

Sub getTextToArray(ByRef Data() As String, _
                   ByVal FilePath As String, _
                   Optional ByVal LineDelimiter As String = vbCrLf, _
                   Optional ByVal FieldDelimiter As String = " ")
    
    ' Write from Text File to Text Variable.
    Dim Text As String: getText Text, FilePath
    
    ' Write from Text Variable to Lines Array.
    Dim Lines() As String: getLines Lines, Text, LineDelimiter
    
    ' Split Lines Array to Data Array.
    getFields Data, Lines, FieldDelimiter

End Sub

Sub getText(ByRef Text As String, _
            ByVal TextFilePath As String)
    Open TextFilePath For Binary As #1
    Text = Space$(LOF(1)): Get #1, , Text
    Close #1
End Sub

Sub getLines(ByRef Lines() As String, _
             ByVal Text As String, _
             Optional ByVal LineDelimiter As String = vbCrLf)
    Lines = Split(Text, LineDelimiter)
    removeLastEmptyLines Lines
End Sub

Sub removeLastEmptyLines(ByRef Lines() As String)
    If UBound(Lines) = -1 Then Exit Sub
    Dim c As Long, ub As Long: ub = UBound(Lines)
    For c = ub To LBound(Lines) Step -1
        If Lines(c) = Empty Then
            ub = ub - 1: ReDim Preserve Lines(ub)
        Else
            Exit For
        End If
    Next c
End Sub

Sub getFields(ByRef Data() As String, _
              Lines() As String, _
              Optional ByVal FieldDelimiter As String = " ")
    Dim Fields() As String: Fields = Split(Lines(0), FieldDelimiter)
    Dim ubL As Long: ubL = UBound(Lines) + 1
    Dim ubF As Long: ubF = UBound(Fields) + 1
    ReDim Data(1 To ubL, 1 To ubF)
    Dim r As Long, c As Long
    For r = 1 To ubL
        Fields = Split(Lines(r - 1), FieldDelimiter)
        For c = 1 To ubF
            Data(r, c) = Fields(c - 1)
        Next c
    Next r
End Sub

Function getColumns(Data() As String, _
                    DataColumns() As Variant) _
         As Variant
    Dim ubD As Long: ubD = UBound(Data)
    Dim ubC As Long: ubC = UBound(DataColumns)
    Dim Result As Variant: ReDim Result(1 To UBound(Data), 1 To ubC + 1)
    Dim r As Long, c As Long
    For r = 1 To ubD
        For c = 0 To ubC
            Result(r, c + 1) = Data(r, DataColumns(c))
        Next c
    Next r
    getColumns = Result
End Function

Sub writeWorksheet(Data As Variant, WorkbookObject As Workbook, _
                   Optional ByVal WorksheetNameOrIndex As Variant = "Sheet1", _
                   Optional ByVal FirstCellAddress As String = "A1")
    With WorkbookObject.Worksheets(WorksheetNameOrIndex).Range(FirstCellAddress)
        .Resize(UBound(Data), UBound(Data, 2)).Value = Data
    End With
End Sub

Copy a given column of a VBA 2D array to a worksheet column

1 Answers1

Write Only Specified Columns From Array to Worksheet