Intersect and Union


Application.Intersect

Returns a Range object that represents the rectangular intersection of two or more ranges.


This example selects the intersection of two named ranges, rg1 and rg2, on Sheet1. If the ranges don't intersect, the example displays a message.

Worksheets("Sheet1").Activate 
Set isect = Application.Intersect(Range("rg1"), Range("rg2"))
If isect Is Nothing Then
    MsgBox "Ranges do not intersect"
Else
    isect.Select
End If


Application.Union

Returns the union of two or more ranges.


This example fills the union of two named ranges, Range1 and Range2, with the formula =RAND().

Worksheets("Sheet1").Activate 
Set bigRange = Application.Union(Range("Range1"), Range("Range2"))
bigRange.Formula = "=RAND()"


Sub Testing_Selection() 
Dim lrowno As Long
Dim icolno As Integer
Dim objObject As Excel.Application
Dim iareatotal As Integer
Dim iareacount As Integer
Dim objFinalSelection As Excel.Range
Dim objUnionSelection As Excel.Range
Dim objcellfirst As Excel.Range
Dim objcellstartofrow As Excel.Range
Dim objSelection As Excel.Range

Set objObject = Application


'    objObject.Range("C4:F15").Select
'    objObject.Selection.FormulaArray = "=RAND()"

'    Set objUnionSelection = objObject.Range("E10")
'    Set objUnionSelection = Union(objUnionSelection, objObject.Range("F13"))
'    objUnionSelection.Select

Set objSelection = objObject.Selection
iareatotal = objSelection.Areas.Count

For iareacount = 1 To iareatotal

lrowno = objSelection.Areas(iareacount).Row
icolno = objSelection.Areas(iareacount).Column

Set objcellfirst = objObject.Cells(lrowno, icolno)
Set objcellstartofrow = objSelection.Areas(iareacount).Offset(0, objObject.Cells(lrowno, icolno).CurrentRegion.Column - icolno)
Set objFinalSelection = objcellstartofrow.Resize(objSelection.Areas(iareacount).Rows.Count, objcellfirst.CurrentRegion.Columns.Count)

If iareacount = 1 Then
Set objUnionSelection = objFinalSelection
Else
Set objUnionSelection = Union(objUnionSelection, objFinalSelection)
End If

Next iareacount

objUnionSelection.Select

End Sub




© 2017 Better Solutions Limited. All Rights Reserved. © 2017 Better Solutions Limited

Top

PrevNext