The difference between the two ranges

I can find many questions and examples regarding the VBA Soyuz and Intersect methods, but I can not find anything about the Set Difference method? Does this exist (other than using combinations of union and intersection)?

I am trying to find a simple way to get the whole range1, excluding any range1 that overlaps range2 without knowing the size or shape of any range.

Any help would be greatly appreciated.

EDIT.

enter image description here

Trying to solve where rng1 is the red section and rng2 is the blue section (debugged to verify that they are correct):

rng = SetDifference(rng, highlightedColumns) Function SetDifference(Rng1 As Range, Rng2 As Range) As Range On Error Resume Next If Application.Intersect(Rng1, Rng2).Address <> Rng2.Address Then Exit Function On Error GoTo 0 Dim aCell As Range For Each aCell In Rng1 Dim Result As Range If Application.Intersect(aCell, Rng2) Is Nothing Then Set Result = Union(Result, aCell) End If Next aCell Set SetDifference = Result End If End Function 
+4
source share
3 answers

Try this function after I improved it a bit:

 Function SetDifference(Rng1 As Range, Rng2 As Range) As Range On Error Resume Next If Intersect(Rng1, Rng2) Is Nothing Then 'if there is no common area then we will set both areas as result Set SetDifference = Union(Rng1, Rng2) 'alternatively 'set SetDifference = Nothing Exit Function End If On Error GoTo 0 Dim aCell As Range For Each aCell In Rng1 Dim Result As Range If Application.Intersect(aCell, Rng2) Is Nothing Then If Result Is Nothing Then Set Result = aCell Else Set Result = Union(Result, aCell) End If End If Next aCell Set SetDifference = Result End Function 

Remember to call it like this:

 Set Rng = SetDifference(Rng, highlightedColumns) 
+7
source

^ Each cell iteration is very slow for calls like

SetDifference (ActiveSheet.Cells, ActiveSheet.Range ("A1")) 'All cells except A1

In this way:

 '(needed by the 2nd function) Public Function Union(ByRef rng1 As Range, _ ByRef rng2 As Range) As Range If rng1 Is Nothing Then Set Union = rng2 Exit Function End If If rng2 Is Nothing Then Set Union = rng1 Exit Function End If If Not rng1.Worksheet Is rng2.Worksheet Then Exit Function End If Set Union = Application.Union(rng1, rng2) End Function Public Function Complement(ByRef rng1 As Range, _ ByRef rng2 As Range) As Range Dim rngResult As Range Dim rngResultCopy As Range Dim rngIntersection As Range Dim rngArea1 As Range Dim rngArea2 As Range Dim lngTop As Long Dim lngLeft As Long Dim lngRight As Long Dim lngBottom As Long If rng1 Is Nothing Then Exit Function End If If rng2 Is Nothing Then Set Complement = rng1 Exit Function End If If Not rng1.Worksheet Is rng2.Worksheet Then Exit Function End If Set rngResult = rng1 For Each rngArea2 In rng2.Areas If rngResult Is Nothing Then Exit For End If Set rngResultCopy = rngResult Set rngResult = Nothing For Each rngArea1 In rngResultCopy.Areas Set rngIntersection = Application.Intersect(rngArea1, rngArea2) If rngIntersection Is Nothing Then Set rngResult = Union(rngResult, rngArea1) Else lngTop = rngIntersection.Row - rngArea1.Row lngLeft = rngIntersection.Column - rngArea1.Column lngRight = rngArea1.Column + rngArea1.Columns.Count - rngIntersection.Column - rngIntersection.Columns.Count lngBottom = rngArea1.Row + rngArea1.Rows.Count - rngIntersection.Row - rngIntersection.Rows.Count If lngTop > 0 Then Set rngResult = Union(rngResult, rngArea1.Resize(lngTop, rngArea1.Columns.Count)) End If If lngLeft > 0 Then Set rngResult = Union(rngResult, rngArea1.Resize(rngArea1.Rows.Count - lngTop - lngBottom, lngLeft).Offset(lngTop, 0)) End If If lngRight > 0 Then Set rngResult = Union(rngResult, rngArea1.Resize(rngArea1.Rows.Count - lngTop - lngBottom, lngRight).Offset(lngTop, rngArea1.Columns.Count - lngRight)) End If If lngBottom > 0 Then Set rngResult = Union(rngResult, rngArea1.Resize(lngBottom, rngArea1.Columns.Count).Offset(rngArea1.Rows.Count - lngBottom, 0)) End If End If Next rngArea1 Next rngArea2 Set Complement = rngResult End Function 
+3
source

If ranges have as few areas as you need a different approach. I did not compose the main idea of ​​this example and I do not remember where I found this idea (using xlCellTypeConstants ). I adapted it so that it works for ranges with areas:

 ' Range operator that was missing Public Function rngDifference(rn1 As Range, rn2 As Range) As Range Dim rnAreaIntersect As Range, varFormulas As Variant Dim rnAreaS As Range, rnAreaR As Range, rnAreaDiff As Range Dim rnAreaModified As Range, rnOut As Range On Error Resume Next Set rngDifference = Nothing If rn1 Is Nothing Then Exit Function If rn2 Is Nothing Then Set rngDifference = rn1: Exit Function Set rnOut = Nothing For Each rnAreaS In rn1.Areas Set rnAreaModified = rnAreaS For Each rnAreaR In rn2.Areas Set rnAreaIntersect = Intersect(rnAreaModified, rnAreaR) If rnAreaIntersect Is Nothing Then Set rnAreaDiff = rnAreaModified Else ' there is interesection 'save varFormulas = rnAreaS.Formula rnAreaS.Value = 0: rnAreaIntersect.ClearContents If rnAreaS.Cells.Count = 1 Then Set rnAreaDiff = Intersect(rnAreaS.SpecialCells(xlCellTypeConstants), rnAreaS) Else Set rnAreaDiff = rnAreaS.SpecialCells(xlCellTypeConstants) End If 'restore rnAreaS.Formula = varFormulas End If If Not (rnAreaModified Is Nothing) Then Set rnAreaModified = Intersect(rnAreaModified, rnAreaDiff) End If Next If Not (rnAreaModified Is Nothing) Then If rnOut Is Nothing Then Set rnOut = rnAreaModified Else Set rnOut = Union(rnOut, rnAreaModified) End If End If Next Set rngDifference = rnOut End Function 

Hope this helps

0
source

All Articles