Subtracting ranges in VBA (Excel)

Your divide and conquer seems like a good way to go. You need to introduce some recursion and should be reasonably fast

Private mrBuild As RangePublic Function SubtractRanges(rFirst As Range, rSecond As Range) As Range    Dim rInter As Range    Dim rReturn As Range    Dim rArea As Range    Set rInter = Intersect(rFirst, rSecond)    Set mrBuild = Nothing    If rInter Is Nothing Then 'No overlap        Set rReturn = rFirst    ElseIf rInter.Address = rFirst.Address Then 'total overlap        Set rReturn = Nothing    Else 'partial overlap        For Each rArea In rFirst.Areas            BuildRange rArea, rInter        Next rArea        Set rReturn = mrBuild    End If    Set SubtractRanges = rReturnEnd FunctionSub BuildRange(rArea As Range, rInter As Range)    Dim rLeft As Range, rRight As Range    Dim rTop As Range, rBottom As Range    If Intersect(rArea, rInter) Is Nothing Then 'no overlap        If mrBuild Is Nothing Then            Set mrBuild = rArea        Else            Set mrBuild = Union(mrBuild, rArea)        End If    Else 'some overlap        If rArea.Columns.Count = 1 Then 'we've exhausted columns, so split on rows            If rArea.Rows.Count > 1 Then 'if one cell left, don't do anything                Set rTop = rArea.Resize(rArea.Rows.Count \ 2) 'split the range top to bottom                Set rBottom = rArea.Resize(rArea.Rows.Count - rTop.Rows.Count).Offset(rTop.Rows.Count)                BuildRange rTop, rInter 'rerun it                BuildRange rBottom, rInter            End If        Else            Set rLeft = rArea.Resize(, rArea.Columns.Count \ 2) 'split the range left to right            Set rRight = rArea.Resize(, rArea.Columns.Count - rLeft.Columns.Count).Offset(, rLeft.Columns.Count)            BuildRange rLeft, rInter 'rerun it            BuildRange rRight, rInter        End If    End IfEnd Sub

These aren't particularly huge ranges, but they all ran fast

?subtractranges(rangE("A1"),range("a10")).Address$A$1?subtractranges(range("a1"),range("a1")) is nothingTrue?subtractranges(range("$B$3,$B$6,$C$8:$W$39"),range("a1:C10")).Address$C$11:$C$39,$D$8:$W$39?subtractranges(range("a1:C10"),range("$B$3,$B$6,$C$8:$W$39")).Address$A$1:$A$10,$B$1:$B$2,$B$4:$B$5,$B$7:$B$10,$C$1:$C$7

My solution is shorter but I don't know if it is optimal one:

Sub RangeSubtraction()    Dim firstRange As Range    Dim secondRange As Range    Dim rIntersect As Range    Dim rOutput As Range    Dim x As Range    Set firstRange = Range("A1:B10")    Set secondRange = Range("A5:B10")    Set rIntersect = Intersect(firstRange, secondRange)    For Each x In firstRange        If Intersect(rIntersect, x) Is Nothing Then            If rOutput Is Nothing Then 'ugly 'if-else' but needed, can't use Union(Nothing, Range("A1")) etc.                Set rOutput = x            Else                Set rOutput = Application.Union(rOutput, x)            End If        End If    Next x    Msgbox rOutput.AddressEnd Sub

Although iterative and not recursive, here's my solution.The function returns the rangeA subtracted by rangeB

public Function SubtractRange(rangeA Range, rangeB as Range) as Range'rangeA is a range to subtract from'rangeB is the range we want to subtract Dim existingRange As Range  Dim resultRange As Range  Set existingRange = rangeA  Set resultRange = Nothing  Dim c As Range  For Each c In existingRange  If Intersect(c, rangeB) Is Nothing Then    If resultRange Is Nothing Then      Set resultRange = c    Else      Set resultRange = Union(c, resultRange)    End If  End If  Next c  Set SubtractRange = resultRangeEnd Sub