Runtime error with exception handling

harvey121

New Member
Joined
Nov 27, 2018
Messages
20
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.


Code:
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
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Instead of using On Error why not check to see if the file(s) exist?

Something like this.
Code:
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.
 
Upvote 0
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:

Code:
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
 
Upvote 0
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.
Code:
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.
 
Upvote 0
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:

Code:
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
 
Upvote 0
Yes, you could pass a string (file name) as the argument.
 
Upvote 0
With the code I posted you could use an array, something like this.
Code:
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
 
Upvote 0
Hi Norie,

Thanks you for your quick response.


But,there seems to be some error in the following line:
Code:
For I = LBound(arrCVS) To UBound


With the code I posted you could use an array, something like this.
Code:
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
 
Upvote 0
Oops, typo I'm afraid.:eek:

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

This is how it should look.
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,884
Messages
6,175,177
Members
452,615
Latest member
bogeys2birdies

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