VBA Error Handling Not working

Question

I am writing a vba program to refresh power queries for a number of reports based on a user saying which reports to refresh via a form with checkboxes.

This part of the code refreshes the power query and I want it to capture the error if the refresh isn't successful. It will update a control table "Not Updated" if it wasn't updated and then I want it to resume next.

For some reason the "On Error Goto Error" isn't triggering the error line. It is still throwing the error and stopping the code run.

Any help would be greatly appreciated!

For Each cell In 
wsConfig.ListObjects("tblReportstoRun").ListColumns(2).DataBodyRange
    If cell.Value = True Then
        cell.Offset(, 1).Value = Now()
        cell.Offset(, 2).Value = frmSetting.tbStartDate
        cell.Offset(, 3).Value = frmSetting.tbEnddate

        strCurrWS = cell.Offset(0, -1)
        ThisWorkbook.Sheets(strCurrWS).Activate
        Application.StatusBar = "Updating tab " & strCurrWS

            For Each qt In ThisWorkbook.Sheets(strCurrWS).QueryTables
                qt.Refresh BackgroundQuery:=False
            Next qt

            For Each lo In ThisWorkbook.Sheets(strCurrWS).ListObjects
                On Error GoTo Error
                lo.QueryTable.Refresh BackgroundQuery:=False
            Next lo
    Else
 Error:
    cell.Offset(, 4).Value = "Not Updated"
    If InStr(Err.Description, "Permission Error") Then
    cell.Offset(, 6).Value = "Permission Error. Check Credentials"
    Err.Clear
    End If


    End If
Next cell

Set qt = Nothing
Set wks = Nothing

Put the Error: at the end of the sub and make sure to use Exit Sub just before that statement. You shouldn't put it in an IFTHEN statement — Maldred
Also, the Error variable is used already, I'd suggest renaming it to something like Errhandle — Maldred

Sobigen Sobigen · Accepted Answer · 2017-12-07T18:27:27

I think you want to avoid having the error handling as part of the normal flow. I'm not sure of the logic you want but if you want to resume back in the For Each lo... loop replaced Resume Top with Resume Next

Sub a()

    For Each cell In wsConfig.ListObjects("tblReportstoRun").ListColumns(2).DataBodyRange
Top:

        If cell.Value = True Then
            cell.Offset(, 1).Value = Now()
            cell.Offset(, 2).Value = frmSetting.tbStartDate
            cell.Offset(, 3).Value = frmSetting.tbEnddate

            strCurrWS = cell.Offset(0, -1)
            ThisWorkbook.Sheets(strCurrWS).Activate
            Application.StatusBar = "Updating tab " & strCurrWS

                For Each qt In ThisWorkbook.Sheets(strCurrWS).QueryTables
                    qt.Refresh BackgroundQuery:=False
                Next qt

                For Each lo In ThisWorkbook.Sheets(strCurrWS).ListObjects
                    On Error GoTo ErrorCatch
                    lo.QueryTable.Refresh BackgroundQuery:=False
                Next lo
        Else
            cell.Offset(, 4).Value = "Not Updated"
        End If
    Next cell

    Set qt = Nothing
    Set wks = Nothing
    Exit Sub
ErrorCatch:
    cell.Offset(, 4).Value = "Not Updated"
    If InStr(Err.Description, "Permission Error") Then
        cell.Offset(, 6).Value = "Permission Error. Check Credentials"
    End If
    Resume Top
End Sub

VBA Error Handling Not working

2 Answers