Difference between two ranges

Try this function after I have improved it a bit:

Function SetDifference(Rng1 As Range, Rng2 As Range) As RangeOn Error Resume NextIf 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 FunctionEnd IfOn Error GoTo 0Dim aCell As RangeFor 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 IfNext aCellSet SetDifference = ResultEnd Function

Remember to call it like this:

Set Rng = SetDifference(Rng, highlightedColumns)

^Iterating by each cell is very slow for calls like

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

Therefore:

'(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 FunctionPublic Function Complement(ByRef rngA As Range, _                           ByRef rngB As Range) As Range    Dim rngResult As Range    Dim rngResultCopy As Range    Dim rngAreaA As Range    Dim rngAreaB As Range    Dim lngX1 As Long    Dim lngY1 As Long    Dim lngX2 As Long    Dim lngY2 As Long    Dim lngX3 As Long    Dim lngY3 As Long    Dim lngX4 As Long    Dim lngY4 As Long    Dim lngX5 As Long    Dim lngY5 As Long    Dim lngX6 As Long    Dim lngY6 As Long    If rngA Is Nothing Then        Exit Function    End If    If rngB Is Nothing Then        Set Complement = rngA        Exit Function    End If    If Not rngA.Worksheet Is rngB.Worksheet Then        Exit Function    End If    Set rngResult = rngA    With rngA.Worksheet        For Each rngAreaB In rngB.Areas            If rngResult Is Nothing Then                Exit For            End If            lngX3 = rngAreaB.Row            lngY3 = rngAreaB.Column            lngX4 = lngX3 + rngAreaB.Rows.Count - 1            lngY4 = lngY3 + rngAreaB.Columns.Count - 1            Set rngResultCopy = rngResult            Set rngResult = Nothing            For Each rngAreaA In rngResultCopy.Areas                lngX1 = rngAreaA.Row                lngY1 = rngAreaA.Column                lngX2 = lngX1 + rngAreaA.Rows.Count - 1                lngY2 = lngY1 + rngAreaA.Columns.Count - 1                If lngX3 > lngX1 Then lngX5 = lngX3 Else lngX5 = lngX1                If lngY3 > lngY1 Then lngY5 = lngY3 Else lngY5 = lngY1                If lngX4 > lngX2 Then lngX6 = lngX2 Else lngX6 = lngX4                If lngY4 > lngY2 Then lngY6 = lngY2 Else lngY6 = lngY4                If lngX5 <= lngX6 And lngY5 <= lngY6 Then                    If lngX5 > lngX1 Then                        Set rngResult = Union(rngResult, .Range(.Cells(lngX1, lngY1), .Cells(lngX5 - 1, lngY2)))                    End If                    If lngY5 > lngY1 Then                        Set rngResult = Union(rngResult, .Range(.Cells(lngX5, lngY1), .Cells(lngX6, lngY5 - 1)))                    End If                    If lngY2 > lngY6 Then                        Set rngResult = Union(rngResult, .Range(.Cells(lngX5, lngY6 + 1), .Cells(lngX6, lngY2)))                    End If                    If lngX2 > lngX6 Then                        Set rngResult = Union(rngResult, .Range(.Cells(lngX6 + 1, lngY1), .Cells(lngX2, lngY2)))                    End If                Else                    Set rngResult = Union(rngResult, rngAreaA)                End If            Next rngAreaA        Next rngAreaB    End With    Set Complement = rngResultEnd Function

When ranges have both multiple areas, you will need a different approach. I did not make up the core idea of this example and do not remember where I found this idea (using xlCellTypeConstants). I adapted it to make it work for ranges with areas:

' Range operator that was missingPublic Function rngDifference(rn1 As Range, rn2 As Range) As RangeDim rnAreaIntersect As Range, varFormulas As VariantDim rnAreaS As Range, rnAreaR As Range, rnAreaDiff As RangeDim 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 = rnOutEnd Function

Hope this helps