Error Handling

[breynolds0431]

Hi. I have error handling set up with GoTo. When I take the error handling out of the procedure, nothing errors out while the procedure runs. When I add the error handling back in, the procedure runs fine. But, I have a msgbox in the error handling and that always displays. So, it seems the VBA is running through the error handling regardless of any error.

There's a lot going on below, but the "On Error" is set right before a workbook.open.

Option Explicit
Sub Find()

Dim sh1 As Worksheet, sh2 As Worksheet, wsh As Worksheet, dic As Object
Dim a As Variant, b As Variant, i As Long

If WorksheetFunction.CountA(Range("B14:B43")) = 0 Then

    MsgBox "There's no data in the ID column. Please add data."
    
    Exit Sub

Else

Dim ans

    ans = MsgBox("This tool may take up to 5 minutes to complete. It's recommended that you do not " & _
    "open or attempt to work with any other excel files until the process completes.", vbOKCancel )

If ans = vbCancel Then
    
    Exit Sub
    
Else

With Application

    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
    .StatusBar = "Finding Data. . . "

End With

Worksheets("MEDataGrab").Range("C14:C43").Select
Selection.TextToColumns Destination:=Range("C14"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True

On Error GoTo Fail

Workbooks.Open fileName:="\\Crossdept - Former S Drive\HIT DR\MEData\MEDataFiles.xlsb", ReadOnly:=True

Application.StatusBar = "Searching Millions of Records. . ."

ThisWorkbook.Activate

Application.StatusBar = "Compiling Results from Millions of Records. . ."

Set wsh = Worksheets("MEDataGrab")

    i = 14
 
    While wsh.Cells(i, 2) <> ""

'Looks in MEData1 tab

    With wsh.Cells(i, 11)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData1!C2,MATCH(1,IF(RC[-8]>=[MEDataFiles.xlsb]MEData1!C3," & _
    "IF(RC[-8]<=[MEDataFiles.xlsb]MEData1!C4,IF(RC[-9]=[MEDataFiles.xlsb]MEData1!C1,1))),0))"
           
    End With
        
    With wsh.Cells(i, 12)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData1!C3,MATCH(1,IF(RC[-9]>=[MEDataFiles.xlsb]MEData1!C3," & _
    "IF(RC[-9]<=[MEDataFiles.xlsb]MEData1!C4,IF(RC[-10]=[MEDataFiles.xlsb]MEData1!C1,1))),0))"
    
    End With
    

    With wsh.Cells(i, 13)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData1!C4,MATCH(1,IF(RC[-10]>=[MEDataFiles.xlsb]MEData1!C3," & _
    "IF(RC[-10]<=[MEDataFiles.xlsb]MEData1!C4,IF(RC[-11]=[MEDataFiles.xlsb]MEData1!C1,1))),0))"
    
    End With

'Looks in MEData2 tab

    With wsh.Cells(i, 14)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData2!C2,MATCH(1,IF(RC[-11]>=[MEDataFiles.xlsb]MEData2!C3," & _
    "IF(RC[-11]<=[MEDataFiles.xlsb]MEData2!C4,IF(RC[-12]=[MEDataFiles.xlsb]MEData2!C1,1))),0))"
           
    End With
        
    With wsh.Cells(i, 15)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData2!C3,MATCH(1,IF(RC[-12]>=[MEDataFiles.xlsb]MEData2!C3," & _
    "IF(RC[-12]<=[MEDataFiles.xlsb]MEData2!C4,IF(RC[-13]=[MEDataFiles.xlsb]MEData2!C1,1))),0))"
    
    End With
    

    With wsh.Cells(i, 16)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData2!C4,MATCH(1,IF(RC[-13]>=[MEDataFiles.xlsb]MEData2!C3," & _
    "IF(RC[-13]<=[MEDataFiles.xlsb]MEData2!C4,IF(RC[-14]=[MEDataFiles.xlsb]MEData2!C1,1))),0))"
    
    End With

'Looks in MEData3 tab

    With wsh.Cells(i, 17)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData3!C2,MATCH(1,IF(RC[-14]>=[MEDataFiles.xlsb]MEData3!C3," & _
    "IF(RC[-14]<=[MEDataFiles.xlsb]MEData3!C4,IF(RC[-15]=[MEDataFiles.xlsb]MEData3!C1,1))),0))"
           
    End With
        
    With wsh.Cells(i, 18)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData3!C3,MATCH(1,IF(RC[-15]>=[MEDataFiles.xlsb]MEData3!C3," & _
    "IF(RC[-15]<=[MEDataFiles.xlsb]MEData3!C4,IF(RC[-16]=[MEDataFiles.xlsb]MEData3!C1,1))),0))"
    
    End With
    

    With wsh.Cells(i, 19)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData3!C4,MATCH(1,IF(RC[-16]>=[MEDataFiles.xlsb]MEData3!C3," & _
    "IF(RC[-16]<=[MEDataFiles.xlsb]MEData3!C4,IF(RC[-17]=[MEDataFiles.xlsb]MEData3!C1,1))),0))"
    
    End With
    

'Looks in MEData4 tab

    With wsh.Cells(i, 20)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData4!C2,MATCH(1,IF(RC[-17]>=[MEDataFiles.xlsb]MEData4!C3," & _
    "IF(RC[-17]<=[MEDataFiles.xlsb]MEData4!C4,IF(RC[-18]=[MEDataFiles.xlsb]MEData4!C1,1))),0))"
           
    End With
        
    With wsh.Cells(i, 21)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData4!C3,MATCH(1,IF(RC[-18]>=[MEDataFiles.xlsb]MEData4!C3," & _
    "IF(RC[-18]<=[MEDataFiles.xlsb]MEData4!C4,IF(RC[-19]=[MEDataFiles.xlsb]MEData4!C1,1))),0))"
    
    End With
    

    With wsh.Cells(i, 22)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData4!C4,MATCH(1,IF(RC[-19]>=[MEDataFiles.xlsb]MEData4!C3," & _
    "IF(RC[-19]<=[MEDataFiles.xlsb]MEData4!C4,IF(RC[-20]=[MEDataFiles.xlsb]MEData4!C1,1))),0))"
    
    End With

'Looks in MEData5 tab

    With wsh.Cells(i, 23)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData5!C2,MATCH(1,IF(RC[-20]>=[MEDataFiles.xlsb]MEData5!C3," & _
    "IF(RC[-20]<=[MEDataFiles.xlsb]MEData5!C4,IF(RC[-21]=[MEDataFiles.xlsb]MEData5!C1,1))),0))"
           
    End With
        
    With wsh.Cells(i, 24)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData5!C3,MATCH(1,IF(RC[-21]>=[MEDataFiles.xlsb]MEData5!C3," & _
    "IF(RC[-21]<=[MEDataFiles.xlsb]MEData5!C4,IF(RC[-22]=[MEDataFiles.xlsb]MEData5!C1,1))),0))"
    
    End With
    

    With wsh.Cells(i, 25)
    .FormulaArray = "=INDEX([MEDataFiles.xlsb]MEData5!C4,MATCH(1,IF(RC[-22]>=[MEDataFiles.xlsb]MEData5!C3," & _
    "IF(RC[-22]<=[MEDataFiles.xlsb]MEData5!C4,IF(RC[-23]=[MEDataFiles.xlsb]MEData5!C1,1))),0))"
    
    End With
    
'Adds formulas to columns D, E, F, and G

    wsh.Cells(i, 4).FormulaR1C1 = _
        "=IFERROR(RC[7],IFERROR(RC[10],IFERROR(RC[13],IFERROR(RC[16],IFERROR(RC[19],""No Data"")))))"
    
    wsh.Cells(i, 5).FormulaR1C1 = _
        "=IFERROR(RC[7],IFERROR(RC[10],IFERROR(RC[13],IFERROR(RC[16],IFERROR(RC[19],""No Data"")))))"
        
    wsh.Cells(i, 6).FormulaR1C1 = _
        "=IFERROR(RC[7],IFERROR(RC[10],IFERROR(RC[13],IFERROR(RC[16],IFERROR(RC[19],""No Data"")))))"
    
    wsh.Cells(i, 7).FormulaR1C1 = _
        "=IF(OR(RC[-5]="""",RC[-3]=""Not Found""),"""",IF(LEN(RC[-3])>2,iferror(VLOOKUP(NUMBERVALUE(LEFT(RC[-3],2))," & _
        "Funding,3,FALSE),VLOOKUP(LEFT(RC[-3],2),Funding,3,FALSE)),VLOOKUP(RC[-3],Funding,3,FALSE)))"
        
    i = i + 1
        
    Wend
    
    Range("D14:Y43").Select
    Selection.Copy
    Application.StatusBar = False
    Range("D14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K14:Y43").ClearContents
    
Workbooks("MEDataFiles.xlsb").Close SaveChanges:=False

Range("B14").Select

With Application

    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = ""
    .Speech.Speak ("Search has now completed!")

End With

End If
End If

Fail:
Call reset

End Sub

Sub reset()

MsgBox "Something went wrong"

    If AlreadyOpen("\\Crossdept - Former S Drive\HIT DR\MEData\MEDataFiles.xlsb") Then
        Application.DisplayAlerts = False
        Workbooks("MEDataFiles.xlsb").Close SaveChanges:=False
    Else
    End If

ThisWorkbook.Sheets("MEDataGrab").Select
Range("B14").Select

With Application

    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False

End With

End Sub

Function AlreadyOpen(sFname As String) As Boolean
    Dim wkbook As Workbook
    On Error Resume Next
    Set wkbook = Workbooks(sFname)
    AlreadyOpen = Not wkbook Is Nothing
    Set wkbook = Nothing
End Function

 

[StephenCrump]

Based only on a 30 second review of your code, you have:

Sub Find()

    On Error GoTo Fail
    'lots of code
    
Fail:
    Call reset

End Sub
Sub reset()

    MsgBox "Something went wrong"
    
End Sub

To prevent the Call reset line always running, perhaps:

Sub Find()

    On Error GoTo Fail
    'lots of code
    
    Exit Sub  'presumably everything OK?
Fail:
    Call reset

End Sub

 

[breynolds0431]

That was the issue. Apparently, I've used error handling incorrectly for some time now. Thank you very much!

 

[lockarde]

Hello! This is a very old post, but my issue is basically the same, so I figured it belonged here. I have a workbook with macros and would like some kind of error handling. So far the only error I have encountered occurs if macros are reset, so it really shouldn't happen to a typical user that isn't debugging/viewing the code. All the same, I'd like to handle this error when it comes up! The snippet of code below is showing where the error occurs:

Sub CalendarMaker(i As Integer, yr As Integer)
Dim calws As Worksheet, ms_new As Worksheet, mos As Integer, mosname As String, newmos As Integer

Set ms_new = Sheets(Sheets.Count)

'Error handle - this should never occur as a typical user should never be in developer mode, and reset the macro.
On Error GoTo err_catch
err_catch:
    MsgBox "Oops! Something went wrong. Refresh Calendar?"
    Call reset

mos = i
mosname = (MonthName(mos) & " " & yr) 'this is where the error occurs.  when macro is reset, i has no value, and so I get a run-time error'

Reset Sub:

Sub reset()
i = Month(Date)
yr = Year(Date)
End Sub

Now, I thought I had it dealt with when I added the On Error. MsgBox displays, and it runs through Reset Sub just fine, and displays the calendar appropriately. However, the msgbox keeps displaying regardless of an error. replication Steps:
1) reset macros
2) click on Calendar Sheet (activating the sheet runs through the calendar macro)
3) run-time error, which gets handled by On Error.
So at this point, i and yr should have values, as Reset Sub was run through
4) change sheets, then go back to calendar - it should function as normal, with no error, but I'm still shown the msgbox.

Now, the reset works fine and I'm shown the month of April correctly. However, I have two buttons for scrolling forward or backward months. The buttons either add or subtract from i and yr depending on which button is clicked, and what the month is (i.e. If you're viewing January and click "Back", i becomes 12, and yr is subtracted 1). Everytime I click one of these buttons, I get the msgbox, even if I haven't reset the macros, and it doesn't actually change the month since it runs through the Reset Sub every time. Hopefully, all of that makes sense! Any help or ideas are greatly appreciated!

 

[lockarde]

I think I got it sorted. First, I had err_check right below the On Error, and so I believe it was running through this regardless - I moved that all the way to the bottom of the CalendarMaker Sub. Second, I put an If statement within err_check that runs if the "Run Type" error #5. If it's that type of error, it shows the msgbox and calls Reset Sub, if not, it does nothing. Probably not the best solution, as it doesnt' allow for any other error types.. if anyone has any ideas on how to make that more effective, I'm all ears!

 

[breynolds0431]

As @StephenCrump pointed out for my issue, try putting Exit Sub right above the err_catch line. That will stop the macro from running err_catch each time.