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

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
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
423
countryfan_nt
countryfan_nt
I
  • Question Question
Error "Unable to set the Name property of the PivotTable class"
Replies
1
Views
249
RoryA
RoryA
R
  • Solved
Removing specific text while saving the exported excel into pdf
Replies
1
Views
397
Rajsngh
R
G
  • Question Question
Combine two separate VBA codes into one
Replies
1
Views
1K
ranman256
ranman256
I
  • Question Question
err no csv found
Replies
3
Views
159
Trebor76
T

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

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