Non-Intersect Range VBA

Question

In the below code rngIntersect.Address returns A10. Is there way where in i can get all ranges excluding intersection without looping?

Answer 1

What you're looking for is the "Complement" in Set Theory terminology. See Wikipedia. This can be done without looping through every cell in both ranges (that would be a huge overhead for ranges with many cells), but you will need to loop though each Area within the range. That loop is quick and efficient. Here's the code:

Public Function NotIntersect(Range1 As Range, Range2 As Range) As Range
Dim NewRange As Range, CurrentArea As Range, CurrentNewArea(1 To 4) As Range, r As Range
Dim c%, a%
Dim TopLeftCell(1 To 2) As Range, BottomRightCell(1 To 2) As Range
Dim NewRanges() As Range, ColNewRanges() As New Collection
Const N% = 2
Const U% = 1

If Range1 Is Nothing And Range2 Is Nothing Then
    Set NotIntersect = Nothing
ElseIf Range1.Address = Range2.Address Then
    Set NotIntersect = Nothing
ElseIf Range1 Is Nothing Then
    Set NotIntersect = Range2
ElseIf Range1 Is Nothing Then
    Set NotIntersect = Range1
Else

    Set TopLeftCell(U) = Range1.Cells(1, 1)
    Set BottomRightCell(U) = Range1.Cells(Range1.Rows.Count, Range1.Columns.Count)

    c = Range2.Areas.Count
    ReDim ColNewRanges(1 To c)
    ReDim NewRanges(1 To c)

    For a = 1 To c
        Set CurrentArea = Range2.Areas(a)
        Set TopLeftCell(N) = CurrentArea.Cells(1, 1)
        Set BottomRightCell(N) = CurrentArea.Cells(CurrentArea.Rows.Count, CurrentArea.Columns.Count)

        On Error Resume Next
        Set ColNewRanges(a) = New Collection
        ColNewRanges(a).Add Range(TopLeftCell(U), Cells(TopLeftCell(N).Row - 1, BottomRightCell(U).Column))
        ColNewRanges(a).Add Range(Cells(TopLeftCell(N).Row, TopLeftCell(U).Column), Cells(BottomRightCell(N).Row, TopLeftCell(N).Column - 1))
        ColNewRanges(a).Add Range(Cells(TopLeftCell(N).Row, BottomRightCell(N).Column + 1), Cells(BottomRightCell(N).Row, BottomRightCell(U).Column))
        ColNewRanges(a).Add Range(Cells(BottomRightCell(N).Row + 1, TopLeftCell(U).Column), BottomRightCell(U))
        On Error GoTo 0

        For Each r In ColNewRanges(a)
            If NewRanges(a) Is Nothing Then
                Set NewRanges(a) = r
            Else
                Set NewRanges(a) = Union(NewRanges(a), r)
            End If
        Next r

    Next a

    For a = 1 To c
        If NewRange Is Nothing Then
            Set NewRange = NewRanges(a)
        Else
            Set NewRange = Intersect(NewRange, NewRanges(a))
        End If
    Next a

    Set NotIntersect = Intersect(Range1, NewRange) 'intersect required in case it's on the bottom or right line, so a part of range will go beyond the line...

End If    
End Function

Test is as follows:

Sub Test1()
    NotIntersect(Range("$A$1:$N$24"), Range("$G$3:$H$12,$C$4:$D$7,$A$13:$A$15")).Select
End Sub