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

[SamT]

Sub VBAX_SamT_GridAndColumnWidth()
Dim GeneTable As Range
Dim FirstCel As Range
Dim LastCel As Range
Dim Brdr As Variant
Dim i As Long

Brdr = Array(xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlInsideHorizontal, xlInsideVertical)

Application.ScreenUpdating = False

With Sheets("Desired")
Set FirstCel = Range("B1").End(xlDown).Offset(, -1)
Set LastCel = Cells(Rows.Count, "F").End(xlUp).Offset(, 1)
Set GeneTabel = Range(FirstCel, LastCel)

With GeneTable
For Brdr = 0 To 5
.Borders(Brdr(i)).LineStyle = xlContinuous
Next
Columns(.Columns.Count).ColumnWidth = 29
End With
End With

Application.ScreenUpdating = True
End Sub