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 Range

Public 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 = rReturn

End Function

Sub 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 If

End 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 nothing
True
?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.Address

End Sub