VBA Error Handling GoTo Next Loop instead of resuming

Viewed 261

This code produces an error when there is no file path in the import tab. Therefore, I included On Error Resume Next in order to run the next loop. However, after On Error Resume Next the code continues to run through the copy operation which messes up the tab I'm copying to.

I identified that the solution is that On Error the code should enter into the next loop instead of continuing the operation. Does anyone have any input on how to change the Error handling to do that?

Sub ImportBS()

Dim filePath As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim Cell As Range
Dim i As Integer
Dim k As Integer
Dim Lastrow As Long


'SourceWb - Workbook were data is copied from
'TargetWb - Workbook were data is copied to and links are stored

Application.ScreenUpdating = False

Set TargetWb = Application.Workbooks("APC Refi Tracker.xlsb")
Lastrow = TargetWb.Sheets("Import").Range("F100").End(xlUp).Row - 6


    For k = 1 To Lastrow
    

        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        Set SourceWb = Workbooks.Open(filePath)
    
    On Error Resume Next
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close

    Next

Application.ScreenUpdating = True

Worksheets("Import").Activate

    MsgBox "All done!"

End Sub
4 Answers

I would do this differently. I would check for the path using Dir function and then decide what to do. here is an example

For k = 1 To Lastrow
    filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
    
    '~~> Check if the path is valid
    If Not Dir(filePath, vbNormal) = vbNullString Then
        Set SourceWb = Workbooks.Open(filePath)
        
        '
        '~~> Rest of your code
        '
    End If
Next

EDIT: corrected code

Try this code (credit for the edit super-symmetry who also linked to this post):

Sub ImportBS()
    
    Dim filePath As String
    Dim SourceWb As Workbook
    Dim TargetWb As Workbook
    Dim Cell As Range
    Dim i As Integer
    Dim k As Integer
    Dim Lastrow As Long
    
    
    'SourceWb - Workbook were data is copied from
    'TargetWb - Workbook were data is copied to and links are stored
    
    Application.ScreenUpdating = False
    
    Set TargetWb = Application.Workbooks("APC Refi Tracker.xlsb")
    Lastrow = TargetWb.Sheets("Import").Range("F100").End(xlUp).Row - 6
    
    On Error Resume Next
    
    For k = 1 To Lastrow
        
        
        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        
        Set SourceWb = Workbooks.Open(filePath)
        
        If Err <> 0 Then GoTo Error_Handler
        
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
Leap:
    Next
    
    On Error GoTo -1
    
    Exit Sub
    
    Error_Handler:
    Err.Clear
    GoTo Leap
    
End Sub    

First (erroneous) answer:

If you want to skip part of your code in case of error, you can use something like this:

    For k = 1 To Lastrow
    

        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        Set SourceWb = Workbooks.Open(filePath)
    
    On Error GoTo Leap
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
Leap:
    Next

I suppose that the error should occur on the line Set SourceWb = Workbooks.Open(filePath). In such case you should probably place the line On Error GoTo Leap before the for's opening; this way it will jump to the next cell in case the first one of the list is empty. I'd also recommend to place a On Error GoTo -1 after the for's closing. Like this:

    On Error GoTo Leap
    
    For k = 1 To Lastrow
    

        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        Set SourceWb = Workbooks.Open(filePath)
        
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
Leap:
    Next
    
    On Error GoTo -1

Import Data

A Quick Fix

For k = 1 To Lastrow
    filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
    Set SourceWb = Nothing
    On Error Resume Next
    Set SourceWb = Workbooks.Open(filePath)
    On Error GoTo 0
    If Not SourceWb Is Nothing Then
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
    'Else ' File not found.
    End If
Next

An Improvement

  • Not tested.
  • Adjust (check) the values in the constants section before using the code.

Option Explicit

Sub ImportBS()

    ' Destination Read
    Const rName As String = "Import" ' where file paths are stored.
    Const rFirstRow As Long = 7
    Const rCol As Variant = "F" ' or 6
    ' Destination Write
    Const wName As String = "Balance Sheet Drop" ' where data is copied to.
    Const wFirstCell As String = "D2"
    Const wRowOffset As Long = 149
    ' Source
    Const srcID As Variant = "Sheet1" ' or e.g. 1 ' where data is copied from.
    Const srcFirstCell As String = "A1"
    
    ' Define Destination Worksheets.
    ' Note that if the workbook "APC Refi Tracker.xlsb" contains this
    ' code, you should use 'Set dstWB = ThisWorkbook' instead which would
    ' make the code more readable, but would also allow you to change
    ' the workbook's name and the code would still work.
    Dim dstWB As Workbook: Set dstWB = Workbooks("APC Refi Tracker.xlsb")
    Dim wsR As Worksheet: Set wsR = dstWB.Worksheets(rName)
    Dim wsW As Worksheet: Set wsW = dstWB.Worksheets(wName)
    
    ' Define Last Row in Destination Read Worksheet.
    Dim rLastRow As Long
    With dstWB.Worksheets(rName)
        rLastRow = .Cells(.Rows.Count, rCol).End(xlUp).Row
    End With
    
    ' Declare additional variables to use in the upcoming loop.
    Dim srcFilePath As String  ' Source File Path
    Dim srcWB As Workbook      ' Source Workbook
    Dim rng As Range           ' Source Range
    Dim i As Long              ' Destination Read Worksheet Rows Counter
    Dim k As Long              ' Destination Write Worksheet Write Counter
    
    Application.ScreenUpdating = False
    
    ' Loop through rows of Destination Read Worksheet
    ' (or loop through Source Workbooks).
    For i = rFirstRow To rLastRow
        ' Read Current Source File Path from Destination Read Worksheet.
        srcFilePath = wsR.Cells(i, rCol).Value
        ' Attempt to open Current Source Workbook.
        Set srcWB = Nothing
        On Error Resume Next
        Set srcWB = Workbooks.Open(srcFilePath)
        On Error GoTo 0
        ' If Current Source Workbook was opened...
        If Not srcWB Is Nothing Then
            ' Define Source Range.
            Set rng = srcWB.Worksheets(srcID).Range(srcFirstCell).CurrentRegion
            ' Define Destination First Cell Range.
            k = k + 1
            ' If a worksheet could not be opened and you want to skip
            ' the 149 lines then replace 'k - 1' with 'i - rFirstRow'
            ' in the following line.
            With wsW.Range(wFirstCell).Offset((k - 1) * wRowOffset)
                ' Write values from Source Range to Destination Range.
                .Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
            End With
            ' Close Source Workbook.
            srcWB.Close SaveChanges:=False
        'Else ' Current Source Workbook was not found.
        End If
    Next
    ' Note that there has been no change of the 'Selection' in any
    ' of the worksheets i.e. what was active at the beginning is still active.
       
    ' Save Destination Workbook.
    'dstWB.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Data sets copied    : " & k & vbLf _
        & "Data sets not copied: " & i - rFirstRow - k, vbInformation, "Success"

End Sub

Try this:

For k = 1 To Lastrow
    filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
    Set SourceWb = Workbooks.Open(filePath)

    On Error Resume Next
    Range("A1").CurrentRegion.Copy
    If Err <> 0 Then GoTo ContinuationPoint
    On Error GoTo 0
    TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial 
    Paste:=xlPasteValues
    Range("A1").Copy
    Application.CutCopyMode = False
    SourceWb.Close

ContinuationPoint:
    On Error GoTo 0
Next

Note two things. I added On Error GoTo 0 in there twice. When you used On Error Resume Next you have essentially turned off error handling. This now turns it back on. If you HAD an error when you tried to copy, then it will just jump to ContinuationPoint (which you can rename to anything you want). Either way, we turn error handling back on.

Related