Consolidating Dynamic Named Ranges from Separate Sheets - excel

Question

My initial understanding is that I may be able to use Union to solve this:
I have different dynamic named ranges for various product types on separate pages in a workbook. All carry the same start cell and column properties, but vary in length based on input data. Is there an easy way to automatically pool these entries into a consolidated list? These are not formatted tables, and I'd prefer to avoid making them into charts.
Ex: Worksheet 1 carries a list of two products (B2:B3) with associated revenue and cost figures in columns C and D. Worksheet 2 carries a list of three products (B2:B4) with... I'd like to have worksheet 3 automatically update with (B2:B6) and columns C and D with data from the original 2 worksheets. This data will grow and will be changed periodically.

Answer 1

Here's one method to emulate UNION
=LET(
data1,FILTER('Worksheet 1'!B:D,'Worksheet 1'!B:B<>""),
data2,FILTER('Worksheet 2'!B:D,'Worksheet 2'!B:B<>""),
rows1,ROWS(data1),
rows2,ROWS(data2),
cols1,COLUMNS(data1),
rowindex,SEQUENCE(rows1+rows2),
colindex,SEQUENCE(1,cols1),
IF(
rowindex<=rows1,
INDEX(data1,rowindex,colindex),
INDEX(data2,rowindex-rows1,colindex))
)

Answer 2

I know my code is probably wildly inefficient - I'm still at the beginning of my learning... Since I couldn't figure out this "union" thing, I ended up running the following code:
Sub dynamicRangeCons()
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim startCell As Range, lastRow As Long, lastCol As Long, ws0 As Worksheet, ws1 As Worksheet
Dim ConsItem As String
Set ws = Worksheets("Cons Ingredients Listing")
ws.Activate
Set startCell = ws.Range("B3")
Set ws0 = ThisWorkbook.Sheets("Cons Ingredients Listing")
Set ws1 = ThisWorkbook.Sheets("Spirits Ingredients Listing")
Set ws2 = ThisWorkbook.Sheets("Beer Ingredients Listing")
Set ws3 = ThisWorkbook.Sheets("Misc Ingredients Listing")
Set ws4 = ThisWorkbook.Sheets("Wine Ingredients Listing")
Set ws5 = ThisWorkbook.Sheets("NA Ingredients Listing")
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).End(xlToRight).Column
ws.Range(startCell, ws.Cells(lastRow, lastCol)).Clear
ws1.Range("SpiritsItem").Copy ws0.Range("B3")
ws1.Range("Spirits").Copy ws0.Range("C3")
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws2.Range("BeerItem").Copy ws.Cells(lastRow + 1, lastCol)
ws2.Range("Beer").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws3.Range("MiscItem").Copy ws.Cells(lastRow + 1, lastCol)
ws3.Range("Misc").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws4.Range("WineItem").Copy ws.Cells(lastRow + 1, lastCol)
ws4.Range("Wine").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws5.Range("NAItem").Copy ws.Cells(lastRow + 1, lastCol)
ws5.Range("NA").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws.Range(startCell, ws.Cells(lastRow, lastCol)).Select
ThisWorkbook.Names.Add Name:="ConsItem", RefersTo:=Selection
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).End(xlToRight).Column
ws.Range(ws.Cells(startCell.Row, startCell.Column + 1), ws.Cells(lastRow, lastCol)).Select
ThisWorkbook.Names.Add Name:="Cons", RefersTo:=Selection
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Answer 3

Consolidate Worksheets
Copy the following into a standard module, e.g. Module1.
Adjust the values in the constants section.
Option Explicit
Sub ConsolidateProducts()
Const sNamesList As String = "Sheet1,Sheet2"
Const sFirst As String = "B2:D2"
Const dName As String = "Sheet3"
Const dFirst As String = "B2"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sNames() As String: sNames = Split(sNamesList, ",")
Dim nUpper As Long: nUpper = UBound(sNames)
Dim nCount As Long: nCount = -1
Dim sData As Variant: ReDim sData(0 To nUpper)
Dim rData() As Long: ReDim rData(0 To nUpper)
Dim sws As Worksheet
Dim srg As Range
Dim sfrrg As Range
Dim slCell As Range
Dim srCount As Long
Dim drCount As Long
Dim n As Long
For n = 0 To nUpper
Set sws = wb.Worksheets(sNames(n))
Set sfrrg = sws.Range(sFirst)
Set slCell = Nothing
Set slCell = sfrrg.Resize(sws.Rows.Count - sfrrg.Row + 1) _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If Not slCell Is Nothing Then
nCount = nCount + 1
srCount = slCell.Row - sfrrg.Row + 1
Set srg = sfrrg.Resize(srCount)
sData(nCount) = srg.Value
rData(nCount) = srCount
drCount = drCount + srCount
End If
Next n
If nCount = -1 Then Exit Sub
Dim cCount As Long: cCount = sfrrg.Columns.Count
Dim dData As Variant: ReDim dData(1 To drCount, 1 To cCount)
Dim s As Long, d As Long, c As Long
For n = 0 To nCount
For s = 1 To rData(n)
d = d + 1
For c = 1 To cCount
dData(d, c) = sData(n)(s, c)
Next c
Next s
Next n
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dfCell As Range: Set dfCell = dws.Range(dFirst)
Dim dfrrg As Range: Set dfrrg = dfCell.Resize(, cCount)
Dim drg As Range: Set drg = dfrrg.Resize(drCount)
drg.Value = dData
Dim dcrg As Range: Set dcrg = dfrrg _
.Resize(dws.Rows.Count - dfrrg.Row - drCount - 1).Offset(drCount)
dcrg.ClearContents
End Sub
If all the data are values then to automate the previous, copy the following into each source module (not the destination (resulting) worksheet).
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const sFirst As String = "B2:D2"
Dim srg As Range
With Range(sFirst)
Set srg = .Resize(Rows.Count - .Row + 1)
End With
Dim irg As Range
Set irg = Intersect(srg, Target)
If Not srg Is Nothing Then
ConsolidateProducts
End If
End Sub