Get Outer Bounding Range of Union with Multiple Areas - excel

Question

Looked high and low, and I haven't found anyone who has talked about this:
I have 2 or more ranges that have been "Unioned" in VBA (so rngUnion.Areas.Count >= 2) and the area ranges are partially contiguous (e.g. rngUnion.Areas(1).address = "A1:Y75", rngUnion.Areas(2).address = "A76:U123", etc.).
What is the simple/efficient way to get the outer bounding range object of the combine areas within rngUnion? I have code below that does this but it seems super kludgy and dumb - I am sure that there is a better way.
Note: I am assuming that there could be other used cells around these areas that are not with the union so I am extremely hesitant to use .CurrentRegion, .UsedRange, or .End(xlUp).Row type methods that are all being suggested for working with ranges.
Sub SomeObfuscatedMethodForGettingAUnionOfPartiallyContiguousAreas()
Dim rng1 As Range: Set rng1 = Range("A1:Y75")
Dim rng2 As Range: Set rng2 = Range("A76:U123")
Dim rngUnion As Range, rngComplete As Range
Set rngUnion = Union(rng1, rng2)
Set rngComplete = GetOuterBoundingRange(rngUnion)
Debug.Print rngComplete.Address 'prints "A1:Y123"
End Sub
Function GetOuterBoundingRange(rngUnion As Range) As Range
Dim minRow As Long: minRow = 2147483647
Dim minCol As Long: minCol = 2147483647
Dim maxRow As Long: maxRow = 0
Dim maxCol As Long: maxRow = 0
Dim minRowTemp As Long
Dim minColTemp As Long
Dim maxRowTemp As Long
Dim maxColTemp As Long
Dim area As Range
For Each area In rngUnion.Areas
minRowTemp = area.Row
maxRowTemp = minRowTemp + area.Rows.Count - 1
minColTemp = area.Column
maxColTemp = minColTemp + area.Columns.Count - 1
If minRowTemp < minRow Then minRow = minRowTemp
If minColTemp < minCol Then minCol = minColTemp
If maxRowTemp > maxRow Then maxRow = maxRowTemp
If maxColTemp > maxCol Then maxCol = maxColTemp
Next area
With rngUnion.parent
Set GetOuterBoundingRange = .Range(.Cells(minRow, minCol), .Cells(maxRow, maxCol))
End With
End Function

Answer 1

As far as I know, there is no build-in function to do so. I don't think your function is that clumsy, in all cases you will need to loop over all areas and find the min and max row and column.
My attempt is a little bit shorter by collecting the numbers into arrays and uses the Min and Max-function, but basically it's doing the same.
Function getR(r As Range) As Range
ReDim minRow(1 To r.Areas.Count) As Long
ReDim maxRow(1 To r.Areas.Count) As Long
ReDim minCol(1 To r.Areas.Count) As Long
ReDim maxCol(1 To r.Areas.Count) As Long
Dim i As Long
For i = 1 To r.Areas.Count
minRow(i) = r.Areas(i).Row
maxRow(i) = r.Areas(i).Row + r.Areas(i).Rows.Count
minCol(i) = r.Areas(i).Column
maxCol(i) = r.Areas(i).Column + r.Areas(i).Columns.Count
Next
With r.Parent
Set getR = .Range(.Cells(WorksheetFunction.Min(minRow), WorksheetFunction.Min(minCol)), _
.Cells(WorksheetFunction.Max(maxRow) - 1, WorksheetFunction.Max(maxCol) - 1))
End With
End Function

Answer 2

This function uses the Application.Range property (Excel) to create the Range Around the Union Range.
Function UnionRange_ƒRangeAround_Set(rUnion As Range) As Range
Dim rOutput As Range, b As Byte
With rUnion
Set rOutput = .Areas(1)
For b = 2 To .Areas.Count
Set rOutput = Range(rOutput, .Areas(b))
Next
End With
Set UnionRange_ƒRangeAround_Set = rOutput
End Function

Answer 3

Since I brought it up, here is a solution which uses a regular expressions. Note for it to work you would need to set a reference to "Microsoft VBScript Regular Expressions 5.5". I pulled all the numbers out of the R1C1 address and used the fact that row numbers and column numbers would alternate, so it would fail if the range in question involved row only or column only references (eg, R3:R4 would break it).
Function getOuterBoundingRange(rngUnion As Range) As Range
Dim regEx As New RegExp
Dim m As Match, oMat As MatchCollection
Dim rowsArr() As Variant
Dim colsArr() As Variant
With regEx
.Global = True
.Pattern = "\d+"
End With
Set oMat = regEx.Execute(rngUnion.Address(, , xlR1C1))
ReDim rowsArr(0 To oMat.Count / 2 - 1)
ReDim colsArr(0 To oMat.Count / 2 - 1)
i = 0
For Each m In oMat
If (i / 2) = Int(i / 2) Then
rowsArr(i / 2) = CLng(m.Value)
Else
colsArr(Int(i / 2)) = CLng(m.Value)
End If
i = i + 1
Next m
With rngUnion.Parent
Set getOuterBoundingRange = .Range(.Cells(WorksheetFunction.Min(rowsArr), WorksheetFunction.Min(colsArr)), _
.Cells(WorksheetFunction.Max(rowsArr), WorksheetFunction.Max(colsArr)))
End With
End Function

Answer 4

Alternative via tricky FilterXML() - //Late Edit as of 2021-11-14
Instead of looping through all areas cell by cell or applying regEx,
I demonstrate how to resolve OP's question alternatively via FilterXML().
I extended #Professor Pantsless'es clever idea to use a R1C1 address of a range Union,
but parsed the address into two parts: the first with entire row indices, and the second with entire column indices.
This allows a minimum/maximum filtering without loops, executed by XPath expressions via FilterXML() (~> see help function getBoundaries).
Function getR(r As Range) As Range
'a) get Boundaries
Dim rc() As Long: rc = getBoundaries(r)
'b) get entire range
With r.Parent
Set getR = .Range(.Cells(rc(1), rc(2)), _
.Cells(rc(3), rc(4)))
End With
End Function
Help function getBoundaries()
Includes the main logic using FilterXML() in three steps:
a) define XPath expressions to find minimal/maximal row/column indices.
b) build a wellformed xml content string by tokenizing the Union range address (where R1C1 mode allows to get numeric values) - uses a further help function getContent().
c) apply FilterXML() based on a wellformed xml content and XPath expressions returning results as a 4-elements array with outer range boundaries.
Function getBoundaries(r As Range) As Long()
'Purp.: return boundaries of range union
'Site: https://stackoverflow.com/questions/69572123/get-outer-bounding-range-of-union-with-multiple-areas
'Date: 2021-10-15
'Auth: [T.M](https://stackoverflow.com/users/6460297/t-m)
'a) define XPath patterns
Const min As String = "//i[not(../i < .)][1]"
Const max As String = "//i[not(../i > .)][1]"
'b)get wellformed xml content (rows|columns)
Dim content As String
'c1)get Row boundaries
content = getContent(r, True) ' help function getContent()
Dim tmp(1 To 4) As Long
tmp(1) = Application.FilterXML(content, min)
tmp(3) = Application.FilterXML(content, max)
'c2)get Column boundaries
content = getContent(r, False) ' << corrected misspelling 2021-11-14 to getContent (inst/of wellformed()
tmp(2) = Application.FilterXML(content, min)
tmp(4) = Application.FilterXML(content, max)
'd) return boundaries array
getBoundaries = tmp
End Function
Help function getContent() (called by above function in section b))
Function getContent(r As Range, ExtractRows As Boolean) As String
'Purp.: get wellformed XML content string
'Meth.: tokenize R1C1-range address into html-like tags
Dim tmp As String
If ExtractRows Then ' extract row numbers
tmp = r.EntireRow.Address(ReferenceStyle:=xlR1C1)
getContent= "<rc><i>" & Replace(Replace(Replace(tmp, "R", ""), ",", ":"), ":", "</i><i>") & "</i></rc>"
Else ' extract column numbers
tmp = r.EntireColumn.Address(ReferenceStyle:=xlR1C1)
getContent= "<rc><i>" & Replace(Replace(Replace(tmp, "C", ""), ",", ":"), ":", "</i><i>") & "</i></rc>"
End If
End Function
Further links
I recommend reading #JvdV 's excellent & nearly encyclopaedic post Extract substrings from string using FilterXML().