VBA Error: Compile Error: Expected End Sub

GingaNinga

New Member
Joined
Sep 1, 2017
Messages
19
Office Version
  1. 365
Platform
  1. Windows
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:

VBA 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

New Member
Joined
Sep 1, 2017
Messages
19
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,723
Office Version
  1. 2010
Platform
  1. Windows

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

New Member
Joined
Sep 1, 2017
Messages
19
Office Version
  1. 365
Platform
  1. Windows
If I knew what that meant - I could fix it myself. But thanks anyways.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,723
Office Version
  1. 2010
Platform
  1. Windows
Just well explain your need, elaborate each step with details in order there in nothin' to guess …​
 

GingaNinga

New Member
Joined
Sep 1, 2017
Messages
19
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Apr 5, 2021
Messages
1,723
Office Version
  1. 2010
Platform
  1. Windows
For starters a VBA demonstration according to your points 1) & 3) :​
VBA Code:
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
 

Forum statistics

Threads
1,147,452
Messages
5,741,209
Members
423,649
Latest member
steel1968

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top