Excel VBA 'On Error Resume Next' causing problems with renaming Table Headers

Question

I want to loop through tables in a workbook and rename certain column headers in tables, to enable the Advanced Filter to copy data. Currently, I'm using On Error Resume Next to avoid Error messages when the column isn't found in the table, and then move on to the next table.

Although this method works absolutely fine, it created problems further down the code when I tried to resize the range of the table. The resizing just didn't work. With help from @HTH, it became apparent that the On Error Resume Next was the problem after some code changes.

Is there a way to fix the On Error Resume Next or should I use a different method to loop through the tables and rename the headings, skipping the tables that don't have those specific headings?

Current Relevant code:

'Loop through and apply a change to all Tables in the Excel Workbook

Dim tbl As ListObject
Dim sht As Worksheet

'Loop through each sheet and table in the workbook
  For Each sht In wb.Worksheets
    For Each tbl In sht.ListObjects
        On Error Resume Next
            'rename headings
            tbl.ListColumns("Ranging").Name = "MS"
            tbl.ListColumns("Stock on Hand - Store").Name = "SOH"
        Next tbl
  Next sht

'Create Filter Criteria ranges
With MainWB.Worksheets.Add
    .Name = "FltrCrit"
    Dim FltrCrit As Worksheet
    Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With

With FltrCrit
    Dim DerangedCrit As Range
    Dim DormantCrit As Range
    Dim OverstockCrit As Range
    Dim OutdatedCrit As Range
    Dim NegCrit As Range
    Dim myLastColumn As Long

    'Create Deranged Filter Criteria Range
    .Cells(1, "A") = "Deranged"
    .Cells(2, "A") = "MS"
    .Cells(3, "A") = "<>4"
    .Cells(2, "B") = "SOH"
    .Cells(3, "B") = "=0"

    'get last column, set range name
    With .Cells

        'find last column of data cell range
        myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

        'specify cell range
        Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))

    End With
End With

'Copy Filtered data to specified tables
Dim tblFiltered As ListObject
Dim copyToRng As Range, SDCRange As Range

'DERANGED
'Store Filtered table in variable
Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")

'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData

'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.HeaderRowRange
Set SDCRange = MainWB.Worksheets(2).ListObjects("Table_SDCdata").Range

'Use Advanced Filter
SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DerangedCrit, CopyToRange:=copyToRng, Unique:=False

'Resize filtered table to include new data
With wb.Worksheets("Deranged with SOH").Cells
        'find last row of source data cell range

        myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 End With

With tblFiltered
        .Resize .HeaderRowRange.Resize(myLastRow - .HeaderRowRange.Rows(1).Row + 1)
End With

'Clear filter data on SDC
MainWB.Worksheets(2).ListObjects("Table_SDCdata").AutoFilter.ShowAllData

try placing OERN right before `For Each sht In wb.Worksheets` and `On Error GoTo 0` right after subsequent `Next sht`. This way you'll 1) avoid calling the same statament at each loops iteration 2) restore default error conditions once you're done — HTH, Apr 17 '20 at 10:56
so let's dig into with the "breakpoint & Immediate Window query of relevant variables value" method — HTH, Apr 17 '20 at 11:21
@HTH sorry it was a mistake on my side, the breakpoint was set to stop just before the resizing. It works perfectly fine as you suggested. Thank you, for the quick help, again! — Simone Evans, Apr 17 '20 at 11:26
@SimoneFick, you are welcome. And from what I can see your coding level is quickly growing. Keep on like that! — HTH, Apr 17 '20 at 11:31
Thanks @HTH, with all this help it makes learning so much quicker. So much more I can improve, but all in good time. — Simone Evans, Apr 17 '20 at 11:32

score 0 · Answer 1 · answered Apr 17 '20 at 11:18

0

The Error Handler can be disabled using:

  On Error GoTo 0

https://learn.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/on-error-statement

If this is causing problems further down it may be that there is an error but the code is resuming to the next line due to the error handler remaining active for the remainder of the procedure. The following will apply the error handler just to the loop and then you can debug your resizing issue:

  On Error Resume Next
    For Each sht In wb.Worksheets
      For Each tbl In sht.ListObjects
            'rename headings
            tbl.ListColumns("Ranging").Name = "MS"
            tbl.ListColumns("Stock on Hand - Store").Name = "SOH"
        Next tbl
    Next sht
  On Error GoTo 0

answered Apr 17 '20 at 11:18

James

11
7

Thanks James, it's the same code changes suggested by HTH in the first comments. It solved the problem. – Simone Evans Apr 17 '20 at 11:28
Glad you sorted it. Apologies, I'm a new contributor so I was a little slower composing my answer. I will have to start refreshing the page before posting! – James Apr 17 '20 at 13:38
No Problem at all. We all have to start somewhere, and I've had the same thing with refreshing pages often on here too. – Simone Evans Apr 17 '20 at 15:09

score 0 · Answer 2 · answered Apr 17 '20 at 11:20

Alright, I whipped this up pretty quickly so it might not be foolproof but you could write a helper function like this:

Public Function HeaderExists(table As ListObject, columnName As String) As Boolean
    On Error GoTo nope
    If Not table.ListColumns(columnName) Is Nothing Then
        HeaderExists = True
    End If
    Exit Function
nope:
    HeaderExists = False
End Function

and then replace that OERN line with

For Each tbl In sht.ListObjects
        'rename headings
    if HeaderExists(tbl, "Ranging") then
        tbl.ListColumns("Ranging").Name = "MS"
    end if
    if HeaderExists(tbl, "Stock on Hand - Store") then
        tbl.ListColumns("Stock on Hand - Store").Name = "SOH"
    end if
Next tbl

I didn't check to see if this messes up anything else in your procedure since it's pretty long, but it should at least properly rename everything.

Thanks @Hayden Moss, solved the On Error Issue with the code changes suggested by HTH in the comments above — Simone Evans, Apr 17 '20 at 11:27

Excel VBA 'On Error Resume Next' causing problems with renaming Table Headers

2 Answers2