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]

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.

And here is the "add a workbook" version for the function I just posted...

Function NotIntersect(rngOne As Range, rngTwo As Range) As Range
  Dim Addr As String, WB As Workbook, WS As Worksheet
  Application.ScreenUpdating = False
  Set WB = Workbooks.Add(Template:=XlWBATemplate.xlWBATWorksheet)
  Set WS = WB.Worksheets(1)
  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)
  WB.Close False
  Application.ScreenUpdating = True
  Set NotIntersect = Range(Addr)
End Function

 

[brettdj]

>In my current project I am trying to remove the intersection of two range objects

That what the codes above are doing. The deletion occurs in a working sheet created purely to map the intersect to remove, ie a much better method compared to looping

Cheers

Dave

Function RemoveIntersect(ByRef rng1 As Range, ByRef rng2 As Range, Optional bBothRanges As Boolean) As String
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim rng3 As Range
    Dim lCalc As Long

    'disable screenupdating, event code and warning messages.
    'set calculation to Manual
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        lCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    'add a working WorkBook
    Set wb = Workbooks.Add(1)
    Set ws1 = wb.Sheets(1)

    On Error Resume Next
    ws1.Range(rng1.Address).Formula = "=NA()"
    ws1.Range(rng2.Address).Formula = vbNullString
    Set rng3 = ws1.Cells.SpecialCells(xlCellTypeFormulas, 16)
    If bBothRanges Then
        ws1.UsedRange.Cells.ClearContents
        ws1.Range(rng2.Address).Formula = "=NA()"
        ws1.Range(rng1.Address).Formula = vbNullString
        Set rng3 = Union(rng3, ws1.Cells.SpecialCells(xlCellTypeFormulas, 16))
    End If
    On Error GoTo 0
    If Not rng3 Is Nothing Then RemoveIntersect = rng3.Address(0, 0)

    'Close the working file
    wb.Close False
    'cleanup user interface and settings
    'reset calculation
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        lCalc = .Calculation
    End With

End Function

Sub Test_the_Code()
    Dim rngTest1 As Range
    Dim rngTest2 As Range
    Dim rngWorking As Range
    Dim strTemp As String

    'Example 1
    'Return the hidden cell range on the ActiveSheet
    Set rngTest1 = ActiveSheet.UsedRange.Cells
    Set rngTest2 = ActiveSheet.UsedRange.SpecialCells(xlVisible)

    If rngTest1.Cells.Count > rngTest2.Cells.Count Then
        strTemp = RemoveIntersect(rngTest1, rngTest2) 
        MsgBox "Hidden cell range is " & strTemp, vbInformation
    Else
        MsgBox "No hidden cells", vbInformation
    End If

    Set rngTest1 = Range("A1:A10,A5:D5")
    Set rngTest2 = Range("A1:D1,D1:D10")
    Set rngWorking = Intersect(rngTest1, rngTest2)

    'Example 2
    'Remove any range overlap from rngTest1
    If Not rngWorking Is Nothing Then
        strTemp = RemoveIntersect(rngTest1, rngTest2)
        MsgBox "Cells removed = " & rngWorking.Address(0, 0) & vbNewLine & _
               "Remaining range is " & strTemp, vbInformation
    Else
        MsgBox "No overlap"
    End If

    'Example 3
    'Combine rngTest1 and rngTest2 where the ranges do not overlap
    'Uses the Boolean True argument to combine the ranges
    If Not rngWorking Is Nothing Then
        strTemp = RemoveIntersect(rngTest1, rngTest2, True)
        MsgBox "Cells removed = " & rngWorking.Address(0, 0) & vbNewLine & _
               "New combined range is " & strTemp, vbInformation
    Else
        MsgBox "No cell overlap" & vbNewLine & _
               "New combined range is " & Union(rngTest1, rngTest2).Address(0, 0), vbInformation
    End If
End Sub

 

[Boswell]

>ie much better method than looping

I disagree in regards to my my particular project; the method is associated with an application level sheet change event. Therefore, the method is executed any time a formula is placed in any cell on any sheet. It doesn't seem practical to create and destroy a workbook every time the user enters a formula into a cell.

If I was in a scenario in which I knew that I was dealing with very large ranges, and could target my calls to the routine more effectively then I would consider the open/close workbook method. (although looping through a variant and looking for formulas is extremely fast... much faster then looping through cells in a range)

Thanks again for your suggestions. You did provide an effective solution to my question.

 

[Greg Truby]

¡DAVE! Great to hear from you. I trust things are well down under. Quite interesting that you solved a similar problem in a similar fashion. I'd never seen your solution (or anything similar). I just figured there had to be a way to leverage .SpecialCells & Intersect to avoid looping.

Boswell - well, yeah, if this is part of a Change event handler that might be more overhead than you'd want.

Rick - okay, so I'm a bit verbose at times when coding. The version below is a bit tighter, though not quite as succinct as yours.

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 booUpdateStat   As Boolean, _
        rngNotISect     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)
    With wsNew
        .Range(rngOne.Address).Value = 1
        .Range(rngTwo.Address).Value = 1
        On Error Resume Next
        Intersect(.Range(rngOne.Address), .Range(rngTwo.Address)).ClearContents
        Set rngNotISect = .Cells.SpecialCells(xlCellTypeConstants)
    End With
 
    If rngNotISect Is Nothing Then
        Set NotIntersect = Nothing
    Else
        Set NotIntersect = wsParent.Range(rngNotISect.Address)
    End If
'// Clean up
    Set rngNotISect = Nothing
    Set wsNew = Nothing
    Set wsParent = Nothing
    wbNew.Close False
    Application.ScreenUpdating = booUpdateStat
End Function

Also, Rick, even though we've never met, I know you by reputation and my guess is that you already know all of this. But on the chance that someone else might read this months or years down the road, I am going to make just a couple of comments: as I said I wrote this thinking that I might want to use this later and the way I code I would be very likely to call the function passing in range variables that pertained to the non-active worksheet. Your code does make the assumption that the ranges passed in are on the active worksheet.

Also - in a function that is designed to be called from w/in VBA, I always store the values of application settings I'm going to alter and restore them rather than assume they need to be reset to defaults. In this case the property in question is ScreenUpdating. It's possible the calling routine(s) had set it to FALSE before calling the function. If the function resets it to true, it might throw a bit of sand in the gears. [BTW, Dave, I did notice you also stored & restored the value of Calculation in your function. :wink:]

 

[brettdj]

¡DAVE! Great to hear from you. I trust things are well down under. Quite interesting that you solved a similar problem in a similar fashion. I'd never seen your solution (or anything similar). I just figured there had to be a way to leverage .SpecialCells & Intersect to avoid looping.

Hey Greg, all going well
I hope all is well with you as well

Yes, I was taken back how similar the codes were, so yes ,practical minds do indeed think alike

Cheers

Dave

 

[Rick Rothstein]

Also, Rick, even though we've never met, I know you by reputation.

I have a reputation? I sure hope it is a good one. I tend to work in isolation here and the only feedback I get on my submissions is the ocassional "Thank you Rick!" from the people whose questions I answer (although sometimes they are a little more effusive than that). Beyond that, I rarely hear anything about how people feel about my submissions. So hearing that I have a reputation comes somewhat as a surprise. Would it be indelicate of me to ask you what that reputation is? If you would be uncomfortable telling me in an open forum like this, please feel free to email it to me (assuming you are willing to do so) at rickDOTnewsATverizonDOTnet where you would replace the upper case letters with the symbols they spell out.

....and my guess is that you already know all of this.

You shouldn't be so sure of that. I'll explain what I mean in a moment.

...as I said I wrote this thinking that I might want to use this later and the way I code I would be very likely to call the function passing in range variables that pertained to the non-active worksheet. Your code does make the assumption that the ranges passed in are on the active worksheet.

Also - in a function that is designed to be called from w/in VBA, I always store the values of application settings I'm going to alter and restore them rather than assume they need to be reset to defaults. In this case the property in question is ScreenUpdating. It's possible the calling routine(s) had set it to FALSE before calling the function. If the function resets it to true, it might throw a bit of sand in the gears.

Okay, those points are fair enough. Here is my code revised to take them into account...

Function NotIntersect(rngOne As Range, rngTwo As Range) As Range
  Dim Addr As String, OriginalScreenSetting As Boolean, WB As Workbook, WS As Worksheet
  OriginalScreenSetting = Application.ScreenUpdating
  Application.ScreenUpdating = False
  Set WB = Workbooks.Add(Template:=XlWBATemplate.xlWBATWorksheet)
  Set WS = WB.Worksheets(1)
  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)
  WB.Close False
  Application.ScreenUpdating = OriginalScreenSetting
  Set NotIntersect = rngOne.Parent.Range(Addr)
End Function

I would point out, though, that both your code and mine allow the passed-in ranges to be from different worksheets (a reasonable flexibility I would think), so the choice of using the parent sheet for the first passed-in range is kind of an arbitrary one. Maybe defaulting to the ActiveSheet but allowing the programmer to redirect the range to a worksheet of their choice would possibly be a better way to go? If so, here is my code modified to do that via an optional third argument...

Function NotIntersect(rngOne As Range, rngTwo As Range, Optional NotIntersectRangeSheet As String) As Range
  Dim X As Long, Addr As String, OriginalScreenSetting As Boolean, WB As Workbook, WS As Worksheet
  If Len(NotIntersectRangeSheet) Then
    For X = 1 To Worksheets.Count
      If StrComp(NotIntersectRangeSheet, Worksheets(X).Name, vbTextCompare) = 0 Then Exit For
    Next
    If X > Worksheets.Count Then
      MsgBox "Whoops"
      Exit Function
    End If
  Else
    NotIntersectRangeSheet = ActiveSheet.Name
  End If
  OriginalScreenSetting = Application.ScreenUpdating
  Application.ScreenUpdating = False
  Set WB = Workbooks.Add(Template:=XlWBATemplate.xlWBATWorksheet)
  Set WS = WB.Worksheets(1)
  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)
  WB.Close False
  Application.ScreenUpdating = OriginalScreenSetting
  Set NotIntersect = Worksheets(NotIntersectRangeSheet).Range(Addr)
End Function

Also, Rick, even though we've never met, I know you by reputation and my guess is that you already know all of this.

Okay, here is the reason that is not necessarily true. Before coming to the Excel world to volunteer answering question, I did my volunteering in the compiled version of VB newsgroups. Several years after VB.NET came out, the number of people asking for help with the "classic version" of VB became less and less until it got to the point where there was very little for me to do there. At that point, I decided to see if I could learn Excel object model and perhaps use whatever VB programming skills I had in the Excel newsgroups/forums. Everything I know about Excel (which is not really all that much) is completely self-taught; but the more important point to understand is that, except for a brief time in the early 1990's, I have no practical experience using Excel... zero... none at all. I have never constructed a spreadsheet for use anywhere... never. So most of the things you and the other volunteers instinctively know to look for and/or protect against, I don't. So when you see me not catering to the kinds of things you just pointed out to me, it is because I do not have an acquired "internal compass" that directs me to do so. Anyway, that is my story and I'm guessing it is an unusual one for an Excel forum volunteer, especially for one who Microsoft was kind enough to honor with one of their MVP awards for the last several years running.

 

[brettdj]

Okay, here is the reason that is not necessarily true. Before coming to the Excel world to volunteer answering question, I did my volunteering in the compiled version of VB newsgroups. Several years after VB.NET came out, the number of people asking for help with the "classic version" of VB became less and less until it got to the point where there was very little for me to do there. At that point, I decided to see if I could learn Excel object model and perhaps use whatever VB programming skills I had in the Excel newsgroups/forums. Everything I know about Excel (which is not really all that much) is completely self-taught; but the more important point to understand is that, except for a brief time in the early 1990's, I have no practical experience using Excel... zero... none at all. I have never constructed a spreadsheet for use anywhere... never. So most of the things you and the other volunteers instinctively know to look for and/or protect against, I don't. So when you see me not catering to the kinds of things you just pointed out to me, it is because I do not have an acquired "internal compass" that directs me to do so. Anyway, that is my story and I'm guessing it is an unusual one for an Excel forum volunteer, especially for one who Microsoft was kind enough to honor with one of their MVP awards for the last several years running.

That was interesting background Rick - it's quite remarkable that you are that technically proficient given your lack of "day job" use. Fwiw it is obvious from your posts here and in the other forums that you clearly know your stuff

Cheers

Dave

 

[Greg Truby]

I have a reputation? I sure hope it is a good one. I tend to work in isolation here and the only feedback I get on my submissions is the ocassional "Thank you Rick!" from the people whose questions I answer (although sometimes they are a little more effusive than that). Beyond that, I rarely hear anything about how people feel about my submissions. So hearing that I have a reputation comes somewhat as a surprise. Would it be indelicate of me to ask you what that reputation is?

I know you from here and from seeing some of your posts here at MrExcel. I met Dave at the last MS MVP summit in Seattle. At the moment I actually not an MS MVP. I started my own Excel development company about two years ago and over this past year or so I just didn't have the time to be very active in forums or online in general, so Melissa didn't renew me in July. I'm trying to up my online participation enough to get back in, but even if I don't it's good to be back on the forum.