^ 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
source share