VBA Error: Compile Error: Expected End Sub

[GingaNinga]

Hello - I have this VBA code which, if I am being honest is a mash up of some simple recorded actions, and a macro that I found online to convert CSVs to XLSX. Independently these work just fine, however when I bring them together I am currently getting a Compile Error: Expected End Sub.

This macro basically has 3 main functions that I am trying to achieve, across a few hundred CSV files exported from another program.

1) Select / Browse to folder where CSV files are located. (These folders change, so the option to select which folder is necessary)
2) Autofit all columns, complete a find & replace, hide columns, and format for printing
3) Convert all CSVs in folder selected, to XLSX using the same file name as the CSV

Here is my current code:

Sub PrepCallScheduleFiles()
'
' PrepCallScheduleFiles Macro
'
' Keyboard Shortcut: Ctrl+a

'Run macro across muliple workbook files at the same time without opening them.
'A browse window should be displayed to select folder which contains the CSV files to apply this macro



    Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
            
'Autofit columns, find & replace *_, hide columns & format for printing


    Columns("A:U").EntireColumn.AutoFit
    Columns("O:O").Select
    Selection.Replace What:="_*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("N1,A:A,G:G,K:K,L:L,M:M,N:N").Select
    Selection.EntireColumn.Hidden = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = -3
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Dim xFd As FileDialog
    Dim xSPath As String
    Dim xCSVFile As String
    Dim xWsheet As String
    Application.DisplayAlerts = False
    Application.StatusBar = True
    xWsheet = ActiveWorkbook.Name
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    xFd.Title = "Select a folder:"
    If xFd.Show = -1 Then
        xSPath = xFd.SelectedItems(1)
    Else
        Exit Sub
    End If
    If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
    xCSVFile = Dir(xSPath & "*.csv")
    Do While xCSVFile <> ""

'Convert workbooks from CSV to XLSX
        
        Application.StatusBar = "Converting: " & xCSVFile
        Workbooks.Open Filename:=xSPath & xCSVFile
        ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
        ActiveWorkbook.Close
        Windows(xWsheet).Activate
        xCSVFile = Dir
    Loop
    Application.StatusBar = False
    Application.DisplayAlerts = True

End With
            xFileName = Dir
        Loop
    End If
End Sub

 

[GingaNinga]

Ok, well just telling me what is wrong is not very helpful.

The idea here is to not have to open hundreds of CSV files to complete these repeatable tasks. I don't have experience with VBA, and some help to adjust the logic would be appreciated.

 

[Marc L]

So you should start to elaborate each step with nothin' to guess and should be easier with some attachment (link on a files host website) …​

 

[GingaNinga]

If I knew what that meant - I could fix it myself. But thanks anyways.

 

[Marc L]

​

Just well explain your need, elaborate each step with details in order there in nothin' to guess …​

 

[GingaNinga]

See my very first post

1) Select / Browse to folder where CSV files are located. (These folders change, so the option to select which folder is necessary)
2) Autofit all columns, complete a find & replace, hide columns, and format for printing
3) Convert all CSVs in folder selected, to XLSX using the same file name as the CSV

Also within the code, I have commented the steps

 

[Marc L]

For starters a VBA demonstration according to your points 1) & 3) :​

Sub Demo1()
      Const C = ".csv"
        Dim P$, F$
    With Application
    With .FileDialog(msoFileDialogFolderPicker)
      If .Show Then P = .SelectedItems(1) & "\" Else Exit Sub
    End With
         .DisplayAlerts = False
         .ScreenUpdating = False
          F = Dir$(P & "*" & C)
    While F > ""
        With Workbooks.Open(P & F)
            .SaveAs P & Replace(F, C, ".xlsx"), 51
            .Close
        End With
          F = Dir$
    Wend
         .DisplayAlerts = True
         .ScreenUpdating = True
    End With
End Sub