Runtime error with exception handling

[harvey121]

In the following code I'm always getting a runtime error in the label file2 when it doesn't exist. As I've handled the exception it should technically proceed forward. When file1 doesn't exist, it's exception is always handled but an error always pops up in the file2 part.

Sub testing()

        
On Error GoTo file2
    Workbooks.Open Filename:="C:Excels\file1.csv"
    
    Windows("file1.csv").Activate
    Columns("A:A").Select
    
    
    Range("A1:A5000").Select
    Selection.Copy
    
    Windows("Basesheet.xlsm").Activate
    Sheets("file1").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    
    Windows("file1.csv").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
   
file2:
    
    On Error GoTo file3
    Workbooks.Open Filename:="C:Excels\file2.csv"
    Windows("file2.csv").Activate
    Columns("A:A").Select
    
    
    Range("A1:A5000").Select
    Selection.Copy
    
    Windows("Basesheet.xlsm").Activate
    Sheets("file2").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    
    Windows("file2.csv").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
file3:


    On Error GoTo file4
    Workbooks.Open Filename:="C:Excels\file3.csv"
    Windows("file3.csv").Activate
    Columns("A:A").Select
    
    
    Range("A1:A5000").Select
    Selection.Copy
    
    Windows("Basesheet.xlsm").Activate
    Sheets("file3").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    
    Windows("file3.csv").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    
    
    
file4:
    On Error GoTo file5
    Workbooks.Open Filename:="C:Excels\file4.csv"
    Windows("file4.csv").Activate
    Columns("A:A").Select
    
    
    Range("A1:A5000").Select
    Selection.Copy
    
    Windows("Basesheet.xlsm").Activate
    Sheets("file4").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    
    Windows("file4.csv").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    
file5:
    On Error GoTo exi
    Workbooks.Open Filename:="C:Excels\file5.csv"
    Windows("file5.csv").Activate
    Columns("A:A").Select
    
    
    Range("A1:A5000").Select
    Selection.Copy
    
    Windows("Basesheet.xlsm").Activate
    Sheets("file5").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    
    Windows("file5.csv").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    
    
    
exi:
Exit Sub




End Sub

 

[Norie]

Instead of using On Error why not check to see if the file(s) exist?

Something like this.

Sub testing()
Dim wbCSV As Workbook
Dim strFilePath As String

    strFilePath = "C:Excels\file1.csv"
        
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file1").Range("A1")
        wbCSV.Close
    End If
   
    strFilePath = "C:Excels\file2.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file2").Range("A1")
        wbCSV.Close
    End If
   
    strFilePath = "C:Excels\file3.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file3").Range("A1")
        wbCSV.Close
    End If
   
    strFilePath = "C:Excels\file4.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file4").Range("A1")
        wbCSV.Close
    End If
       
    strFilePath = "C:Excels\file5.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file5").Range("A1")
        wbCSV.Close
    End If
    
End Sub

PS You could use an array for the CSV filenames and cut this code down significantly.

 

[RoryA]

You're not actually handling the exception at all (see http://excelmatters.com/2015/03/17/on-error-wtf/). This code should really be refactored though due to the huge repetition - something like:

Sub testing()
Dim n as long
for n = 1 to 5
    OpenAndCopyFile n
next n

End Sub
    
Sub OpenAndCopyFile(n as long)
    On Error Resume Next
    dim wb as workbook
    set wb = Workbooks.Open(Filename:="C:Excels\file" & n & ".csv"
    wb.sheets(1).Range("A1:A5000").Copy workbooks("Basesheet.xlsm").Sheets("file" & n).Range("A1") 
    wb.Close False

End Sub

 

[harvey121]

Thank you so much. This works perfectly.

Instead of using On Error why not check to see if the file(s) exist?

Something like this.

Sub testing()
Dim wbCSV As Workbook
Dim strFilePath As String

    strFilePath = "C:Excels\file1.csv"
        
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file1").Range("A1")
        wbCSV.Close
    End If
   
    strFilePath = "C:Excels\file2.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file2").Range("A1")
        wbCSV.Close
    End If
   
    strFilePath = "C:Excels\file3.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file3").Range("A1")
        wbCSV.Close
    End If
   
    strFilePath = "C:Excels\file4.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file4").Range("A1")
        wbCSV.Close
    End If
       
    strFilePath = "C:Excels\file5.csv"
   
    If Len(Dir(strFilePath)) <> 0 Then
        Set wbCSV = Workbooks.Open(Filename:=strFilePath)
        wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets("file5").Range("A1")
        wbCSV.Close
    End If
    
End Sub

PS You could use an array for the CSV filenames and cut this code down significantly.

 

[harvey121]

Hi,

I am new to vba but I will remember to optimize my code for future use. One more thing I'd like to ask is that, instead of file paths being file1,file2...,can this code be modified to pick different file names like student,class,school.

You're not actually handling the exception at all (see http://excelmatters.com/2015/03/17/on-error-wtf/). This code should really be refactored though due to the huge repetition - something like:

Sub testing()
Dim n as long
for n = 1 to 5
    OpenAndCopyFile n
next n

End Sub
    
Sub OpenAndCopyFile(n as long)
    On Error Resume Next
    dim wb as workbook
    set wb = Workbooks.Open(Filename:="C:Excels\file" & n & ".csv"
    wb.sheets(1).Range("A1:A5000").Copy workbooks("Basesheet.xlsm").Sheets("file" & n).Range("A1") 
    wb.Close False

End Sub

 

[RoryA]

Yes, you could pass a string (file name) as the argument.

 

[harvey121]

I am new to this, can you help me with this.

Yes, you could pass a string (file name) as the argument.

 

[Norie]

With the code I posted you could use an array, something like this.

Sub testing()
Dim wbCSV As Workbook
Dim strFilePath As String
Dim arrCSVFiles As Variant
Dim I As Long

    arrCSVFiles = Array("student","class","school")

    For I = LBound(arrCVS) To UBound
    
        strFilePath = "C:Excels\" & arrCSVFiles(I) & ".csv"
        
        If Len(Dir(strFilePath)) <> 0 Then
            Set wbCSV = Workbooks.Open(Filename:=strFilePath)
            wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets(arrCSVFiles(I)).Range("A1")
            wbCSV.Close
        End If
   Next I

End Sub

 

[harvey121]

Hi Norie,

Thanks you for your quick response.


But,there seems to be some error in the following line:

For I = LBound(arrCVS) To UBound

With the code I posted you could use an array, something like this.

Sub testing()
Dim wbCSV As Workbook
Dim strFilePath As String
Dim arrCSVFiles As Variant
Dim I As Long

    arrCSVFiles = Array("student","class","school")

    For I = LBound(arrCVS) To UBound
    
        strFilePath = "C:Excels\" & arrCSVFiles(I) & ".csv"
        
        If Len(Dir(strFilePath)) <> 0 Then
            Set wbCSV = Workbooks.Open(Filename:=strFilePath)
            wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets(arrCSVFiles(I)).Range("A1")
            wbCSV.Close
        End If
   Next I

End Sub

 

[Norie]

Oops, typo I'm afraid.

Well not really a typo, I basically missed a whole chunk of code.

This is how it should look.

Sub testing()
Dim wbCSV As Workbook
Dim strFilePath As String
Dim arrCSVFiles As Variant
Dim I As Long

    arrCSVFiles = Array("student", "class", "school")

    For I = LBound(arrCSVFiles) To UBound(arrCSVFiles)
    
        strFilePath = "C:Excels\" & arrCSVFiles(I) & ".csv"
        
        If Len(Dir(strFilePath)) <> 0 Then
            Set wbCSV = Workbooks.Open(Filename:=strFilePath)
            wbCSV.Sheets(1).Range("A1:A5000").Copy Workbooks("Basesheet.xlsm").Sheets(arrCSVFiles(I)).Range("A1")
            wbCSV.Close
        End If
   Next I

End Sub