Tables interfere with VBA range variables dependin

问题:

An Excel file includes VBA-coded user-defined functions (UDFs) that are deployed in tables (VBA listobjects). Now, for reasons that escape me, if the UDF module contains Range variables that are declared outside the scope of any sub or function, I get a very dramatic warning when the file is opened: "Automatic error -- Catastrophic failure".

"Catastrophic" seems like an exaggeration because after the warning is dismissed, the file seems to work correctly. But I would still like to understand what the issue is. I have managed to replicate the issue with an MVC example as follows. I'm running Excel 2016 (updated) on Windows 10.

There are two tables (i.e. VBA listobjects): Table 1 lists "items" and Table 2 lists "item features" (both tables were generated by selecting the data and clicking Table on the Insert tab). Table 2 has a UDF called ITEM_NAME() in the field Item_Name that returns the item name as a function of the item ID, see the screenshot:

The function ITEM_NAME() is essentially a wrapper around the regular worksheet functions INDEX and MATCH, as in the following code:

Option Explicit

Dim mrngItemNumber As Range
Dim mrngItemName As Range

Public Function ITEM_NAME(varItemNumber As Variant) As String
' Returns Item Name as a function of Item Number.
    Set mrngItemNumber = Sheets(1).Range("A4:A6")
    Set mrngItemName = Sheets(1).Range("B4:B6")
    ITEM_NAME = Application.WorksheetFunction.Index(mrngItemName, _
    Application.WorksheetFunction.Match(varItemNumber, mrngItemNumber))
End Function

So, to repeat, with this setup I get the Automation error when the file is opened. But the error disappears when I do any of the following:

1. Move the declarations into the scope of the function. This solution is not attractive since it requires many more lines of code, one for each UDF, and there are many.

2. Change the variable type from Range to something else, for example Integer (so the function will obviously not work).

3. Convert Table 2 to an ordinary range (i.e. remove the table). This is also an inconvenient solution since I really want to use the Table features for other purposes in my code.

4. Remove the function ITEM_NAME() from Table 2. (Obviously no attractive option..)

What's going on? Why do I get the error message? And why does the file still seem to work properly despite the warning? Is there a workaround that I've missed?

I suspect it might have something to do with how sheet objects and listobjects interact, but not sure. A possible hint is provided in this answer to another question:

If you want to reference a table without using the sheet, you can use a hack Application.Range(ListObjectName).ListObject.

NOTE: This hack relies on the fact that Excel always creates a named range for the table's DataBodyRange with the same name as the table.

Similar problems have been reported elsewhere (at Stackoverflow and Microsoft Technet), but not with this particular flavor. Suggested solutions include checking for broken references or other processes running in the background, and I've done that to no avail. I can also add that it makes no difference whether the function ITEM_NAME is entered after Table 2 is created rather than before; the only difference is that it uses structured references in that case (as in the screenshot above).

UPDATE: Inspired by @SJR's comments below I tried the following variation of the code, where a ListObject variable is declared to store the table "Items". Note that the Range declarations are now inside the scope of the function, and that only the ListObject declaration is outside. This also generates the same Automation error!

Option Explicit

Dim mloItems As ListObject

Public Function ITEM_NAME(varItemNumber As Variant) As String
' Returns Item Name as a function of Item Number.
    Dim rngItemNumber As Range
    Dim rngItemName As Range
    Set mloItems = Sheet1.ListObjects("Items")
    Set rngItemNumber = mloItems.ListColumns(1).DataBodyRange
    Set rngItemName = mloItems.ListColumns(2).DataBodyRange
    ITEM_NAME = Application.WorksheetFunction.Index(rngItemName, _
    Application.WorksheetFunction.Match(varItemNumber, rngItemNumber))
End Function

UPDATE 2: The problem now seems to be solved, but I'm not much wiser as to what actually caused it. Since no one could replicate (not even friends of mine who opened the same file on different systems), I began to think that it was a local issue. I tried repairing Excel and then even reinstalled the complete Office package from scratch. But the issue still persisted, both with my MCV files used to create the example above and the original file where I discovered the problem.

I decided to try to create a new version of the MCV example where, inspired by AndrewD's answer below, I used .ListObjects() to set the range instead of using .Range(). This did indeed work. I will probably adapt that solution for my work (but see my comments under AndrewD's question explaining why I might prefer .Range().)

In order to double check that this solution worked, I set about to create two new files, one to replicate my own example as described above, and one where the only difference would be the switch to ListObjects(). In the process, I noted that I had actually indented the Range declarations at the beginning of the code in my original file, like so:

Option Explicit

    Dim mrngItemNumber As Range
    Dim mrngItemName As Range

Public Function ITEM_NAME(...

Without thinking much about this, I created the new file but without indentation. So that would be an exact copy of the previous file (and the given example above), but without indentation. But behold, with this file I could not replicate the Automation error! After inspecting both files I noted that the only difference was indeed indentation, so I put the indentation back again in the new file expecting it to generate the Automation error again. But the problem did not reappear. So then I then removed the indentation from the first file (used to create the example above), and now the Automation error disappeared from that file as well. Armed with this observation, I went back to my real file where I first discovered the issue and simply removed the indentation there too. And it worked.

So to summarize, after removing the indentation of the Range declarations I fail to recreate the Automation error in any of the three files that had generated it before. And moreover, the problem does not reappear even if I put the indentation back in place again. But I still don't understand why.

Thanks everyone who took time to look at this and shared valuable ideas.

回答1:

Declaring module-level variables simply to save the two lines in each UDF that would otherwise be required is indeed bad coding practice. However, if that is your thinking, why not go all the way and save four lines per UDF by avoiding setting them in each as well!

You can do this by using pseudo-constant functions as seen in the following code:

Option Explicit

Private Function rng_ItemNumber() As Range
    Set rng_ItemNumber = Sheet1.Range("A4:A6")
End Function
Private Function rng_ItemName() As Range
    Set rng_ItemName = Sheet1.Range("B4:B6")
End Function

Public Function ITEM_NAME(varItemNumber As Variant) As String
' Returns Item Name as a function of Item Number.
  With Application.WorksheetFunction
    ITEM_NAME = .Index(rng_ItemName, .Match(varItemNumber, rng_ItemNumber))
  End With
End Function

The cost, of course, is the overhead of a function call.

---

If you are planning on using the ListObject class for the final design, then why not use it now, and also use dynamic named ranges (the hard-coded ranges in the example are there so it actually works as is - these should be replaced with the named ranges):

Option Explicit

Private Function str_Table1() As String
    Static sstrTable1 As String
    If sstrTable1 = vbNullString Then
      sstrTable1 = Sheet1.Range("A4:B6").ListObject.Name
    End If
    str_Table1 = sstrTable1
End Function
Private Function str_ItemNumber() As String
    Static sstrItemNumber As String
    If sstrItemNumber = vbNullString Then
      sstrItemNumber = Sheet1.Range("A4:A6").Offset(-1).Resize(1).Value2
    End If
    str_ItemNumber = sstrItemNumber
End Function
Private Function str_ItemName() As String
    Static sstrItemName As String
    If sstrItemName = vbNullString Then
      sstrItemName = Sheet1.Range("B4:B6").Offset(-1).Resize(1).Value2
    End If
    str_ItemName = sstrItemName
End Function

Public Function ITEM_NAME(varItemNumber As Variant) As String
  'Returns Item Name as a function of Item Number.
  Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction
  With Sheet1.ListObjects(str_Table1)
    ITEM_NAME _
    = ƒ.Index _
      ( _
        .ListColumns(str_ItemName).DataBodyRange _
      , ƒ.Match(varItemNumber, .ListColumns(str_ItemNumber).DataBodyRange) _
      )
  End With
End Function

Once the logic/design is ready, you can replace the functions with module-level constants of the same name if speed is critical and you need to reclaim the function call overhead. Otherwise, you can just leave everything as is.

Note that the use of static variables is not required, but should reduce execution time. (Static variables could also have been used in the first example as well, but I left them out to keep it short.)

It's probably not really necessary to extract out the table names into pseudo-constants, but I have done so for completeness sake.

---

EDIT: (v2)

Following up on Egalth's two brilliant suggestions, leads to the follow code which obviates the need for named ranges, or even hard-coded cell addresses, altogether as we leverage the builtin dynamism of the ListObject table itself.

I have also changed the parameter name to match* the relevant column header name so when the user presses Ctrl+Shift+A a hint as to which column to use appears. (This tip and, if required, more info on how to add Intellisense tool-tips and/or get a description to appear in the Function Arguments dialog can be seen here.)

Option Explicit

Private Function str_Table1() As String
    Static sstrTable1 As String
    If sstrTable1 = vbNullString Then sstrTable1 = Sheet1.ListObjects(1).Name ' or .ListObjects("Table1").Name
    str_Table1 = sstrTable1
End Function
Private Function str_ItemNumber() As String
    Static sstrItemNumber As String
    If sstrItemNumber = vbNullString Then
      sstrItemNumber = Sheet1.ListObjects(str_Table1).HeaderRowRange(1).Value2
    End If
    str_ItemNumber = sstrItemNumber
End Function
Private Function str_ItemName() As String
    Static sstrItemName As String
    If sstrItemName = vbNullString Then
      sstrItemName = Sheet1.ListObjects(str_Table1).HeaderRowRange(2).Value2
    End If
    str_ItemName = sstrItemName
End Function

Public Function ITEM_NAME(ByRef Item_ID As Variant) As String
  'Returns Item Name as a function of Item Number.
  Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction
  With Sheet1.ListObjects(str_Table1)
    ITEM_NAME _
    = ƒ.Index _
      ( _
        .ListColumns(str_ItemName).DataBodyRange _
      , ƒ.Match(Item_ID, .ListColumns(str_ItemNumber).DataBodyRange) _
      )
  End With
End Function

Note the usage of .Value2. I have always used .Value2 ever since I found out about the performance drag and other issues caused by the implicit type conversion done when using .Value (or when relying on it as the default property).

_{* Make sure to update the column header names in the code when the logic/design of the project is finished.}

---

EDIT: (re-boot)

Re-reading your own comments to your posted Question, I noted this one:

I might adopt that approach eventually, but I'm still in the design process and moving columns around a lot so the index number might also change

Whilst the last example above allows the header names to be changed dynamically, moving/inserting columns changes the indexes, requiring the code to be modified.

Looks like we're back to using named ranges. However, this time we only need static ones pointing to the column headers.

It also turns out that, for this new case, static variables are a bad idea in the design stage. Since the column indexes are cached, inserting a new column breaks the UDF until the project is reset.

I have also incorporated a shortened version of the sheet-less table reference hack from the quote in your posted Question:

Option Explicit

Private Function str_Table1() As String
    str_Table1 = Sheet1.ListObjects(1).Name
End Function
Private Function str_ItemNumber() As String
    With Range(str_Table1).ListObject
      str_ItemNumber = .HeaderRowRange(.Parent.Range("A3").Column - .HeaderRowRange.Column + 1).Value2
    End With
End Function
Private Function str_ItemName() As String
    With Range(str_Table1).ListObject
      str_ItemName = .HeaderRowRange(.Parent.Range("B3").Column - .HeaderRowRange.Column + 1).Value2
    End With
End Function

Public Function ITEM_NAME(ByRef Item_ID As Variant) As String
  'Returns Item Name as a function of Item Number.
  Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction
  With Range(str_Table1).ListObject
    ITEM_NAME _
    = ƒ.Index _
      ( _
        .ListColumns(str_ItemName).DataBodyRange _
      , ƒ.Match(Item_ID, .ListColumns(str_ItemNumber).DataBodyRange) _
      )
  End With
End Function

Note that you can't use Item_name for one of the named ranges as it is the same as the UDF (case is ignored). I suggest using a trailing underscore, eg, Item_name_, for your named ranges.

---

All the above methods would also have solved the original issue that you had. I'm awaiting the last pieces of info in order to make an educated guess as to why this issue was occurring in the first place.

回答2:

OK. This workaround should work.

If When it does, there are a few issues and caveats to address.

I'll also post explanations.

Install the code in the ThisWorkbook module.

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  Dim rngCell As Range

  For Each rngCell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
    With rngCell
      If .FormulaR1C1 Like "*ITEM_NAME*" _
      And Left$(.FormulaR1C1, 4) <> "=T(""" _
      Then
        .Value = "=T(""" & .FormulaR1C1 & """)"
      End If
    End With
  Next rngCell

End Sub

Private Sub Workbook_Open()

  Dim rngCell As Range

  For Each rngCell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
    With rngCell
      If .FormulaR1C1 Like "*ITEM_NAME*" _
      And Left$(.FormulaR1C1, 4) = "=T(""" _
      Then
        .FormulaR1C1 = .Value
      End If
    End With
  Next rngCell

End Sub

回答3:

On a purely code level, why declare modular-level variables to store the ranges when you set them every single time? If you were caching the references and only setting them if Nothing I could understand...but then you would use a Static to reduce the scope.

My preference would be to not bother with the modular (or local/static) variables, replace the Worksheet.Name reference with Worksheet.CodeName (less likely to be changed and, if you compile after a rename you get an error) and refer to the table ranges via the ListObject and ListColumns (in case the table size changes).

' Returns the item name for the requested item ID.
Public Function ITEM_NAME(ByVal ItemID As Variant) As String
    ITEM_NAME = Application.WorksheetFunction.Index( _
                      Sheet1.ListObjects("Table1").ListColumns("Item_name").DataBodyRange _
                    , Application.WorksheetFunction.Match( _
                          ItemID _
                        , Sheet1.ListObjects("Table1").ListColumns("Item_ID").DataBodyRange _
                        ) _
                    )
End Function

But the most robust solution would be to avoid a UDF and use =INDEX(Table1[Item_name],MATCH([@[Item_ID]],Table1[Item_ID]‌​)) (VLOOKUP may be slightly faster but INDEX+MATCH is more robust).