VBA Error: Compile Error: Expected End Sub

G

GingaNinga

New Member
Joined
Sep 1, 2017
Messages
26
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
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
Hello !​
​
Yes 'cause you have two consecutive Sub codelines at the beginning of your code ‼ So try to remove one …​
 
Upvote 0
Marc L said:
Hello !​
​
Yes 'cause you have two consecutive Sub codelines at the beginning of your code ‼ So try to remove one …​
Click to expand...
Thanks for your help. I removed one, but am now getting Compile Error: Duplicate declaration in current scope.

It is flagging this : xFd As FileDialog in my code
 
Upvote 0
​
According to VBA help - easy to read, at kid level - any procedure must start with a Sub codeline​
and must ends with an End Sub codeline before any other Sub codeline.​
​
But in your code there is no End Sub codeline before the second Sub codeline …​
 
Upvote 0
Thank you - now I am getting this error:

Compile Error: Duplicate declaration in current scope

It is flagging this line of code : xFd As FileDialog

VBA Code: 
' 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 & "*.csv*")
        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
 
Upvote 0
​
Obviously according to the error message why did you create such duplicate codeline ?‼​
​
The reason why any Dim codeline must be at the top of the procedure like VBA help advises, avoiding this kind of coding error …​
 
Upvote 0
As I said - I have mashed up a recorded macro - and one that I found online. I am not very familiar with VBA, obviously.

So, I have commented out the duplicate line. Now, it will run, and prompt me to select the folder. It actually prompts me twice. Presumably the first is to select the folder to convert the CSV files from, the second to select where to put the XLSX?

However, it only converts the first CSV file in the directory, then throws this error:

Capture.JPG


This line of code is highlighted yellow: Windows(xWsheet).Activate
 
Upvote 0

As Coping / Pasting can't be coding so again an error but without knowing on which codeline the error raises​
it's just a challenge for some mind readers forum ! So check the yellow codeline in debug mode …​
 
Upvote 0
Marc L said:
​
As Coping / Pasting can't be coding so again an error but without knowing on which codeline the error raises​
it's just a challenge for some mind readers forum ! So check the yellow codeline in debug mode …​
Click to expand...
Capture.JPG
 
Upvote 0
​
As the workbook is already closed so the error raises ! Logic used needs a great review …​
 
Upvote 0
You must log in or register to reply here.

Similar threads

countryfan_nt
  • Solved
Copy Header to all the headers of the workbooks in a specific folder.
Replies
2
Views
309
countryfan_nt
countryfan_nt
R
  • Solved
Removing specific text while saving the exported excel into pdf
Replies
1
Views
295
Rajsngh
R
G
  • Question
Combine two separate VBA codes into one
Replies
1
Views
938
ranman256
ranman256
muhammad susanto
  • Solved
VBA : Convert CSV To XLSX Can't Save Into Different Folder
Replies
3
Views
2K
DanteAmor
DanteAmor
M
  • Question
Make mandatory cells before closing (saving) for multiple workbooks
Replies
9
Views
429
mradomir
M

Forum statistics

Threads
1,215,056
Messages
6,122,907
Members
449,096
Latest member
dbomb1414

Share this page

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
Back
Top