return range that is *not* in Intersection

B

Boswell

Board Regular
Joined
Jun 18, 2010
Messages
224
Hello,

Is there a method for setting a range equal to the cells that are not in the intersection of two other ranges...

Code: 
set resultRange = NotIntersection(inRange1,inRange2)
Note: the code above is just an example, does not work.

I imagine that if if there were no cells that exist in both ranges then it would return the Union of both ranges. Anyone know of a built in function to return this... or a quick custom function (ideally it would be much quicker than looping through all cells in the individual ranges)

Any help will be greatly appreciated.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Does this do what you want?
Code: 
Function NotIntersection(R1 As Range, R2 As Range) As Range
  Dim I As Range
  Set I = Intersect(R1, R2)
  Dim C As Range
  For Each C In Union(R1, R2)
    If Intersect(C, I) Is Nothing Then
      If NotIntersection Is Nothing Then
        Set NotIntersection = C
      Else
        Set NotIntersection = Union(C, NotIntersection)
      End If
    End If
  Next
End Function
 
Upvote 0
Yes, The result of this function is exactly what I want. However; it loops through every cell in the union of the ranges.. which is a performance problem I am trying to avoid.
 
Upvote 0
Pretty much, the answer is No, one must loop through every cell in the union of the two ranges.

There are specific tricks for specific situations that would shorten the looping, but not a nifty quick equivalence of the symmetric difference range operator.

(the semmetric difference of two sets is those elements that are in only one set)
 
Upvote 0
Um, with a bit of creativity and assuming the workbook is not protected such that you cannot insert a new worksheet, then yeah, you can do this w/o looping the cells. If there's a danger of the protection thing surfacing, then you could alter the code to add a new workbook and do the trickery there.

Rich (BB code): 
Function NotIntersect(rngOne As Excel.Range, rngTwo As Excel.Range) As Excel.Range
    '// written by Greg Truby
    '// 26 July 2011
    '// in response to forum thread
    '// http://www.mrexcel.com/forum/showthread.php?t=567096
    
    Dim booAlertStat    As Boolean, _
        booUpdateStat   As Boolean, _
        rngISect        As Excel.Range, _
        rngNotISect     As Excel.Range, _
        rngNewOne       As Excel.Range, _
        rngNewTwo       As Excel.Range, _
        rngUnion        As Excel.Range, _
        wsNew           As Excel.Worksheet, _
        wsParent        As Excel.Worksheet
    
    booUpdateStat = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set wsParent = rngOne.Parent
    Set wsNew = Worksheets.Add
    
    Set rngISect = Application.Intersect(rngOne, rngTwo)
    
    If rngISect Is Nothing Then
        Set NotIntersect = Union(rngOne, rngTwo)
        GoTo TimeToGo
    End If
    Set rngNewOne = wsNew.Range(rngOne.Address)
    Set rngNewTwo = wsNew.Range(rngTwo.Address)
    
    rngNewOne.Formula = "1"
    rngNewTwo.Formula = "1"
    wsNew.Range(rngISect.Address).ClearContents
    Set rngUnion = Union(rngNewOne, rngNewTwo)
    On Error Resume Next
    Set rngNotISect = rngUnion.SpecialCells(xlCellTypeConstants, XlSpecialCellsValue.xlNumbers)
    If rngNotISect Is Nothing Then
        Set NotIntersect = Nothing
    Else
        Set NotIntersect = wsParent.Range(rngNotISect.Address)
    End If

TimeToGo:
'¨¨¨¨¨¨¨¨
    booAlertStat = Application.DisplayAlerts
    With Application
        .DisplayAlerts = False
        wsNew.Delete
        .DisplayAlerts = booAlertStat
        .ScreenUpdating = booUpdateStat
    End With
End Function

Sub test()
    Dim rngTest As Excel.Range, R1 As Excel.Range, R2 As Excel.Range
    '// no overlap
    Set R1 = Range("A1:B3")
    Set R2 = Range("D5:F7")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbRed
    
    Set rngTest = NotIntersect(R1, R2)
    rngTest.Interior.Color = vbMagenta
    MsgBox rngTest.Address, vbInformation
    
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    R2.Interior.Color = XlColorIndex.xlColorIndexNone
    rngTest.Interior.Color = XlColorIndex.xlColorIndexNone
    '// some overlap
    Set R1 = Range("A1:D6")
    Set R2 = Range("C3:F9")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbRed
    Set rngTest = NotIntersect(R1, R2)
    rngTest.Interior.Color = vbMagenta
    MsgBox rngTest.Address, vbInformation
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    R2.Interior.Color = XlColorIndex.xlColorIndexNone
    rngTest.Interior.Color = XlColorIndex.xlColorIndexNone
    '// 2 inside 1
    
    Set R1 = Range("A1:F10")
    Set R2 = Range("C3:E7")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbRed
    Set rngTest = NotIntersect(R1, R2)
    rngTest.Interior.Color = vbMagenta
    MsgBox rngTest.Address, vbInformation
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    R2.Interior.Color = XlColorIndex.xlColorIndexNone
    rngTest.Interior.Color = XlColorIndex.xlColorIndexNone
    '// 1 = 2
    
    Set R1 = Range("A1:D6")
    Set R2 = Range("A1:D6")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbRed
    Set rngTest = NotIntersect(R1, R2)
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    '// should error out since "not intersect" will be nothing
    MsgBox rngTest.Address, vbInformation

End Sub
 
Last edited:
Upvote 0
I figured I would keep a copy of this for myself, it might just come in handy some day. So I went ahead and just added the new workbook bit to avoid any protection entanglements.
Code: 
Function NotIntersect(rngOne As Excel.Range, rngTwo As Excel.Range) As Excel.Range
    '// written by Greg Truby
    '// 26 July 2011
    '// in response to forum thread
    '// [URL]http://www.mrexcel.com/forum/showthread.php?t=567096[/URL]
 
    Dim booUpdateStat   As Boolean, _
        rngISect        As Excel.Range, _
        rngNotISect     As Excel.Range, _
        rngNewOne       As Excel.Range, _
        rngNewTwo       As Excel.Range, _
        rngUnion        As Excel.Range, _
        wbNew           As Excel.Workbook, _
        wsNew           As Excel.Worksheet, _
        wsParent        As Excel.Worksheet
 
    booUpdateStat = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set wsParent = rngOne.Parent
    Set wbNew = Workbooks.Add(Template:=XlWBATemplate.xlWBATWorksheet)
    Set wsNew = wbNew.Worksheets(1)
 
    Set rngISect = Application.Intersect(rngOne, rngTwo)
 
    If rngISect Is Nothing Then
        Set NotIntersect = Union(rngOne, rngTwo)
        GoTo TimeToGo
    End If
    Set rngNewOne = wsNew.Range(rngOne.Address)
    Set rngNewTwo = wsNew.Range(rngTwo.Address)
 
    rngNewOne.Formula = "1"
    rngNewTwo.Formula = "1"
    wsNew.Range(rngISect.Address).ClearContents
    Set rngUnion = Union(rngNewOne, rngNewTwo)
    On Error Resume Next
    Set rngNotISect = rngUnion.SpecialCells(xlCellTypeConstants, XlSpecialCellsValue.xlNumbers)
    If rngNotISect Is Nothing Then
        Set NotIntersect = Nothing
    Else
        Set NotIntersect = wsParent.Range(rngNotISect.Address)
    End If
 
TimeToGo:
'¨¨¨¨¨¨¨¨
    With Application
        wbNew.Close False
        .ScreenUpdating = booUpdateStat
    End With
End Function
 
Sub test()
    On Error Resume Next
 
    Dim rngTest As Excel.Range, R1 As Excel.Range, R2 As Excel.Range
    '// no overlap
    Set R1 = Range("A1:B3")
    Set R2 = Range("D5:F7")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbYellow
    If Not Application.Intersect(R1, R2) Is Nothing Then
        Application.Intersect(R1, R2).Interior.Color = vbGreen
    End If
 
    Set rngTest = NotIntersect(R1, R2)
    rngTest.Interior.Color = vbMagenta
    MsgBox rngTest.Address, vbInformation
 
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    R2.Interior.Color = XlColorIndex.xlColorIndexNone
    rngTest.Interior.Color = XlColorIndex.xlColorIndexNone
    '// some overlap
    Set R1 = Range("A1:D6")
    Set R2 = Range("C3:F9")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbYellow
    If Not Application.Intersect(R1, R2) Is Nothing Then
        Application.Intersect(R1, R2).Interior.Color = vbGreen
    End If
    Set rngTest = NotIntersect(R1, R2)
    rngTest.Interior.Color = vbMagenta
    MsgBox rngTest.Address, vbInformation
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    R2.Interior.Color = XlColorIndex.xlColorIndexNone
    rngTest.Interior.Color = XlColorIndex.xlColorIndexNone
    '// 2 inside 1
 
    Set R1 = Range("A1:F10")
    Set R2 = Range("C3:E7")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbYellow
    If Not Application.Intersect(R1, R2) Is Nothing Then
        Application.Intersect(R1, R2).Interior.Color = vbGreen
    End If
    Set rngTest = NotIntersect(R1, R2)
    rngTest.Interior.Color = vbMagenta
    MsgBox rngTest.Address, vbInformation
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    R2.Interior.Color = XlColorIndex.xlColorIndexNone
    rngTest.Interior.Color = XlColorIndex.xlColorIndexNone
    '// 1 = 2
 
    Set R1 = Range("A1:D6")
    Set R2 = Range("A1:D6")
    R1.Interior.Color = vbBlue
    R2.Interior.Color = vbYellow
    If Not Application.Intersect(R1, R2) Is Nothing Then
        Application.Intersect(R1, R2).Interior.Color = vbGreen
    End If
    Set rngTest = NotIntersect(R1, R2)
    R1.Interior.Color = XlColorIndex.xlColorIndexNone
    If Err.Number <> 0 Then
        MsgBox "R1 = R2 (NotIntersect is Nothing)", vbInformation
    Else
        MsgBox rngTest.Address, vbInformation
    End If
 
End Sub
 
Upvote 0
Greg Truby said:
Um, with a bit of creativity and assuming the workbook is not protected such that you cannot insert a new worksheet, then yeah, you can do this w/o looping the cells. If there's a danger of the protection thing surfacing, then you could alter the code to add a new workbook and do the trickery there.[/code]
Click to expand...
Your function seems to have more code than I envisioned would be needed (more variables as well). Unless I missed something (quite possible), this function seems to work the same as yours...
Code: 
Function NotIntersect(rngOne As Range, rngTwo As Range) As Range
  Dim Addr As String, WS As Worksheet
  Application.ScreenUpdating = False
  Set WS = Worksheets.Add
  WS.Range(rngOne.Address).Value = "X"
  WS.Range(rngTwo.Address).Value = "X"
  On Error Resume Next
  Intersect(WS.Range(rngOne.Address), WS.Range(rngTwo.Address)).Clear
  Addr = Cells.SpecialCells(xlCellTypeConstants).Address(0, 0)
  Application.DisplayAlerts = False
  WS.Delete
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Set NotIntersect = Range(Addr)
End Function
 
Upvote 0
Thank you all for your replies. Those are very creative solutions. In my current project I am trying to remove the intersection of two range objects (not actually delete items from a sheet). However, the suggested methods look very handy for such a purpose.

I found a work around solution that fit my particular need. Specifically, my need was to remove cells containing a specific formula from the Target.SpecialCells(xlFormulas) range in a sheet change event (as quickly as possible). I was able to do this quickly by setting a variant equal to Target.SpecialCells(xlFormulas).Formula, and then looping through the variant to determine the positions of the cells containing the specific formula.. and then using the position to add those cells to a new range via the Union method. This made it possible for me to only access the range when a cell containing the desired formula was present. The method I came up with is very tailored to my specific need but I will be glad to post code if anyone is interested.

Thanks Again!:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Finding all combinations to a summed value
Replies
9
Views
461
cerberus1845
C
Jaafar Tribak
  • Solved
Subtracting Ranges
Replies
6
Views
539
Jaafar Tribak
Jaafar Tribak
W
  • Question Question
Excel VBA - Check For Duplicates and Return the Count on a Large Data Set
Replies
4
Views
358
Kaper
Kaper
S
  • Question Question
Excel VBA - Sort & Get Totals - Logic
Replies
4
Views
419
STARL0RD
S
M
  • Solved
Deleting rows from a Range variable
Replies
4
Views
305
Umma123
U

Forum statistics

Threads
1,224,564
Messages
6,179,547
Members
452,925
Latest member
duyvmex

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top