Table At: Who lives here?

This content is licensed under The MIT License. See here for more details.

Imagine we have a sheet with a table that needs to reference a previous month, and I want to templatize it. Well, that’s easy, just duplicate it! Except, the referring column gets changed each time, so you’ll end up with what was in the template, not the last sheet…​

No big deal, just reference that cell on the previous sheet. Two problems:

  1. This sortable, filterable table will break A1/R1C1 references.

  2. The template should hold the reference, and it can’t reference itself (circular reference).

So how do we solve this?

How about a lookup that checks the sheet immediately to the left? Well, that’s great in theory, but tough to implement. See, you can easily get the sheet number (SHEET()) and subtract 1 to form a reference, but that doesn’t give us a nice named reference. So we need to find the table. Excel doesn’t have an easy way to get a table from a location (other way around is easy). So let’s make one. Let’s assume we know a cell address that the table will overlap (e.g., R1C1), so we just need to look at every table in the sheet and find the first one that overlaps that:

' Takes an address, returns a table
Function TABLEAT(ref As Excel.range) As Excel.ListObject
    ' Search through each table in the worksheet the given range was in
    For Each tabl In ref.Worksheet.ListObjects
        ' If a table intersects the given range, return it
        If InRange(tabl.range, ref) Then
            Set TABLEAT = tabl
        End If
    Next tabl
End Function

' Helper function to work around an Excel bug
Function InRange(RangeA As Excel.range, RangeB As Excel.range) As Boolean
    InRange = Not (Application.Intersect(RangeA, RangeB) Is Nothing)
End Function

It’d also be nice to have the name of the sheet, so we aren’t relying on indexes:

Function SHEETNAME(number As Long) As String
    SHEETNAME = Sheets(number).Name
End Function

And now we can use our old friend XLOOKUP to find our data in the named column in the table on the sheet to the left:

Look up the value of NameColumn and return the relevant value of TargetColumn in LookupTable:

=LET(
    table,
    TABLEAT(INDIRECT(ADDRESS(1, 1, 1, 0, SHEETNAME(SHEET() - 1)), FALSE)),
    XLOOKUP(
        [@<NameColumn>],
        INDIRECT(CONCAT(table, "[", <LookupTable>[[#Headers], [<NameColumn>]], "]")),
        INDIRECT(CONCAT(table, "[", <LookupTable>[[#Headers], [<TargetColumn>]], "]")),
        NA(),
        0,
        1
    )
)

End result is a template that when cloned, immediately has strongly-named references to the worksheet to the left of it that will survive sorting and filtering. Zero user-interaction required.