XLA routines: EE_RangeSubtract

Nick's picture
Use EE_RangeSubtract to subtract a range from another
Public Function EE_RangeSubtract(ByVal rng1 As range, ByVal rng2 As range) As range
    Dim rngSmall        As range
    Dim rngBig          As range
    Dim rngIntersect    As range
    Dim rngTopRows      As range
    Dim rngBtmRows      As range
    Dim rngLeftCols     As range
    Dim rngRightCols    As range
    Dim rngUnion        As range
    Dim strMsg          As String
 
'http://excelexperts.com/xla-routines-eeRangeSubtract    for updates on this function

    If rng1.Areas.Count > 1 Or rng2.Areas.Count > 1 Then
        strMsg = "Both the ranges should be rectangular."
        GoTo ErrH
    ElseIf rng1.Address = rng2.Address Then
        strMsg = "Both ranges are equal."
        GoTo ErrH
    Else
        If EE_GetCellCount(rng1) < EE_GetCellCount(rng2) Then
            Set rngSmall = rng1
            Set rngBig = rng2
        Else
            Set rngSmall = rng2
            Set rngBig = rng1
        End If
    End If
    On Error Resume Next
    Set rngIntersect = Intersect(rngSmall, rngBig)
    On Error GoTo 0
    If rngIntersect Is Nothing Then
        strMsg = "No common area in two ranges"
        GoTo ErrH
    Else
        If rngIntersect.Address <> rngSmall.Address Then
            Set rngSmall = rngIntersect
        End If
 
    'Top Rows
        If rngBig.Rows(1).Row <> rngSmall.Rows(1).Row Then
            Set rngTopRows = rngBig.Rows(1).Resize(rngSmall.Rows(1).Row - rngBig.Rows(1).Row)
            Call EE_AppendToRange(rngUnion, rngTopRows)
        End If
    'Bottom Rows
        If rngBig.Rows(rngBig.Rows.Count).Row <> rngSmall.Rows(rngSmall.Rows.Count).Row Then
            Set rngBtmRows = rngBig.Rows(rngSmall.Rows(rngSmall.Rows.Count).Row - rngBig.Rows(1).Row + 2).Resize(rngBig.Rows(rngBig.Rows.Count).Row - rngSmall.Rows(rngSmall.Rows.Count).Row)
            Call EE_AppendToRange(rngUnion, rngBtmRows)
        End If
    'Left Colums
        If rngBig.Columns(1).Column <> rngSmall.Columns(1).Column Then
            Set rngLeftCols = rngBig.Columns(1).Resize(, rngSmall.Columns(1).Column - rngBig.Columns(1).Column)
            Call EE_AppendToRange(rngUnion, rngLeftCols)
        End If
    'Right Columns
        If rngBig.Columns(rngBig.Columns.Count).Column <> rngSmall.Columns(rngSmall.Columns.Count).Column Then
            Set rngRightCols = rngBig.Columns(rngSmall.Columns(rngSmall.Columns.Count).Column - rngBig.Columns(1).Column + 2).Resize(, rngBig.Columns(rngBig.Columns.Count).Column - rngSmall.Columns(rngSmall.Columns.Count).Column)
            Call EE_AppendToRange(rngUnion, rngRightCols)
        End If
    End If
    Set EE_RangeSubtract = rngUnion
    GoTo ExitH
ErrH:
    Set EE_RangeSubtract = Nothing
ExitH:
    Set rngSmall = Nothing
    Set rngBig = Nothing
    Set rngIntersect = Nothing
    Set rngTopRows = Nothing
    Set rngBtmRows = Nothing
    Set rngLeftCols = Nothing
    Set rngRightCols = Nothing
    Set rngUnion = Nothing
End Function
 
 
Private Sub EE_AppendToRange(rngAppendTo As range, rngAppend As range)
    If Not rngAppendTo Is Nothing Then
        Set rngAppendTo = Union(rngAppendTo, rngAppend)
    Else
        Set rngAppendTo = rngAppend
    End If
End Sub