Consolidating Dynamic Named Ranges from Separate Sheets

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.

Screenshots of the inputs and the expected output would help here. — Tim Williams, Jun 08 '21 at 02:04
Which of the columns `B:D` contain formulas and which contain values (in 1 and 2)? — VBasic2008, Jun 08 '21 at 05:39

score 2 · Answer 1 · answered Jun 08 '21 at 02:04

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

score 0 · Answer 2 · answered Jun 08 '21 at 04:01

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

score 0 · Answer 3 · answered Jun 08 '21 at 06:41

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

Consolidating Dynamic Named Ranges from Separate Sheets

3 Answers3

Consolidate Worksheets

Linked