cmccabe1
01-19-2016, 01:12 PM
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
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