place grid in parsed xlsx

[cmccabe1]

On the attached sheet the current tab is the output of the VBA below. I want to add a grid and resize the "Notes" column, but the problem is that that entire section is variable (sometimes it is 4 rows other times it is 10). I'm not really sure the best way to get the desired output. Thank you .

VBA

Sub CreateXLSXFiles(fn As String)
' PARSE TEXT FILE AND CREATE XLSX REPORT '
Dim txt As String, m As Object, n As Long, fp As String
Dim i As Long, x, temp, ub As Long, myList


     myList = Array("Display Name", "Medical Record", "Date of Birth", _
                    "Order Date", "Gender", "Barcode", "Sample", "Build", _
                    "SpikeIn", "Location", "Control Gender", "Quality")


    fp = "C:\Users\cmccabe\Desktop\EmArray\"


    With Worksheets(1)
        .Cells.Clear
        .Name = CreateObject("Scripting.FileSystemObject").GetBaseName(fn)
    On Error Resume Next
    n = FileLen(fn)
    If Err Then
        MsgBox "Something wrong with " & fn
        Exit Sub
    End If
    On Error GoTo 0
    n = 0
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        For i = 0 To UBound(myList)
            .Pattern = "^#(" & myList(i) & " = (.*))"
            If .Test(txt) Then
                n = n + 1
                Sheets(1).Cells(n, 1).Resize(, 2).Value = _
                Array(.Execute(txt)(0).submatches(0), .Execute(txt)(0).submatches(1))
            End If
        Next
        .Pattern = "^[^#\r\n](.*[\r\n]+.+)+"
        x = Split(.Execute(txt)(0), vbCrLf)
        .Pattern = "(\t| {2,})"
        temp = Split(.Replace(x(0), Chr(2)), Chr(2))
        n = n + 1
        For i = 0 To UBound(temp)
            Sheets(1).Cells(n, i + 1).Value = temp(i)
        Next
        ub = UBound(temp)
        .Pattern = "((\t| {2,})| (?=(\d|"")))"
        For i = 1 To UBound(x)
            temp = Split(.Replace(x(i), Chr(2)), Chr(2))
            n = n + 1
            Sheets(1).Cells(n, 1).Resize(, ub).Value = temp
        Next
    End With
    .Copy
        Application.DisplayAlerts = False
        With ActiveSheet
             .Columns.AutoFit
             .Range("B1:B12").ClearContents
        End With
        ActiveWorkbook.SaveAs Filename:=fp & .Name, _
                              FileFormat:=xlOpenXMLWorkbook
        ActiveWorkbook.Close False
    End With
End Sub