return range that is *not* in Intersection

[Boswell]

Hello,

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

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.

 

[Rick Rothstein]

Does this do what you want?

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

 

[Boswell]

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.

 

[mikerickson]

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)

 

[Greg Truby]

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.

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

 

[Greg Truby]

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.

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

 

[brettdj]

My code in this article avoids looping the range, see Adding a "Subtract Range" method alongside Union & Intersect

I posted the article rather than just the code as it gives a better understanding of how it works and how to apply it

Cheers

Dave

 

[brettdj]

.. which having read Greg's post more closely seems very similar in construct

Cheers

Dave

 

[Rick Rothstein]

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]

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

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

 

[Boswell]

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!