resize xlsx output with vba

[cmccabe]

The below VB is almost complete but when the xlsx is saved to the directory, I need to resize and then remove B1:B12. I added these lines in hopes of doing that but I am getting a Select method of range class failed. Thank you .

Cells.Select
Cells.EntireColumn.AutoFit
Range("B1:B12").Select
Selection.ClearContents

Option Explicit
Private Sub CommandButton21_Click()
    Dim myDir As String, fn As String
    myDir = "C:\Users\cmccabe\Desktop\EmArray\"
    fn = Dir(myDir & "*.txt")
    Do While fn <> ""
       CreateXLSXFiles myDir & fn
       fn = Dir
    Loop
 End Sub
 Sub CreateXLSXFiles(fn As String)
     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
        ActiveWorkbook.SaveAs Filename:=fp & .Name, _
                              FileFormat:=xlOpenXMLWorkbook
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("B1:B12").Select
    Selection.ClearContents
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
    End With
End Sub

[JLGWhiz]

You are inside a With statement, so your cells and range references need a period in front of them to tie them to the object. But maybe this would work in place of what you are trying:

.Columns.AutoFit
.Range("B1:B12").ClearContents

although I am not sure why you are using autofit at that juncture.

[cmccabe]

The VB below is almost done except that it outputs to the directory as the current shows in the attachment and not in the desired way also in the attachment. My attempts are not working and I need some help in getting this to work. Also, the rows in the outline can be variable (sometimes 5 and other times 15. Thank you .

VB

Option Explicit
Private Sub CommandButton21_Click()
    Dim myDir As String, fn As String
    myDir = "C:\Users\cmccabe\Desktop\EmArray\"
    fn = Dir(myDir & "*.txt")
    Do While fn <> ""
       CreateXLSXFiles myDir & fn
       fn = Dir
    Loop
 End Sub
 Sub CreateXLSXFiles(fn As String)
     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
        ActiveWorkbook.SaveAs Filename:=fp & .Name, _
                              FileFormat:=xlOpenXMLWorkbook
        .Columns.AutoFit
        .Range("B1:B12").ClearContents
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
    End With
End Sub

[JLGWhiz]

I think I see the problem now. Try replacing this

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fp & .Name, _
FileFormat:=xlOpenXMLWorkbook
.Columns.AutoFit
.Range("B1:B12").ClearContents
ActiveWorkbook.Close False

With this

Application.DisplayAlerts = False
        With ActiveSheet
             .Columns.AutoFit
             .Range("B1:B12").ClearContents
        End With
        ActiveWorkbook.SaveAs Filename:=fp & .Name, _
                              FileFormat:=xlOpenXMLWorkbook       
        ActiveWorkbook.Close False

[cmccabe]

Thank you very much.... it works great .

[JLGWhiz]

Thank you very much.... it works great .

You're Welcome,
Regards, JLG