VBA: How to combine two ranges on different sheets into one, to loop through

The Union function cannot span multiple worksheets (as any range object is contained by a single Worksheet object). If you want to process multiple ranges on different sheets in one loop you need to think about a different strategy, e.g.

Sub test()
Dim AllAreas(2) As Range, Idx As Integer, MyCell As Range, TargetRange As Range

    Set AllAreas(0) = Worksheets("Sheet1").[C4]
    Set AllAreas(1) = Worksheets("Sheet2").[D5]
    Set AllAreas(2) = Worksheets("Sheet3").[E6]
    Set TargetRange = Worksheets("Sheet4").[A1]

    For Idx = 0 To 2
        For Each MyCell In AllAreas(Idx).Cells
            MyCell = "co-cooo!"
            ' combine in targetrange - each cell of any source range is put at same position
            ' in sheet 4 ... mind the precedence ... highest sheet highest prio
            TargetRange(MyCell.Row, MyCell.Column) = MyCell
        Next MyCell
    Next Idx
End Sub

You can find the overlay of all ranges by the minimum and maximum .Row and .Column of all ranges within the array of ranges, so if you have a complex set of rules to aggregate parially overlapping ranges, start with finding min and max corners, run through all cells of the target range and ask: is there a value in area 0, 1, 2, … and if so, then decide which one takes precedence.

To make things even more elegant you can build …

Type RngDef
    Rng As Range
    MinCol As Integer
    MaxCol As Integer
    MinRow As Integer
    MaxRow As Integer
End Type

Sub test2()

Dim AllAreas(2) As RngDef, Idx As Integer, MyCell As Range, TargetRange As Range

    Set AllAreas(0).Rng = Worksheets("Sheet1").[C4]
    Set AllAreas(1).Rng = Worksheets("Sheet2").[D5]
    Set AllAreas(2).Rng = Worksheets("Sheet3").[E6]

    For Idx = 0 To 2
        AllAreas(Idx).MinCol = AllAreas(Idx).Rng(1, 1).Column
        AllAreas(Idx).MinRow = AllAreas(Idx).Rng(1, 1).Row
        AllAreas(Idx).MaxCol = AllAreas(Idx).MinCol + AllAreas(Idx).Rng.Columns.Count - 1
        AllAreas(Idx).MaxRow = AllAreas(Idx).MinRow + AllAreas(Idx).Rng.Rows.Count - 1
    Next Idx

    Set TargetRange = Worksheets("Sheet4").[A1]


End Sub

Now you have all ranges and their boundaries at hand …

Leave a Comment