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

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