Tables interfere with VBA range variables depending on scope

可紊 提交于 2019-11-28 12:11:37

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.

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

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).

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!