Sub TestRun()
 
    Dim rngDiff As Range
 
    Set rngDiff = DeltaRange(Sheet1.Range("A1:E20"), Sheet1.Range("B5:D15"))
 
    If Not rngDiff Is Nothing Then
 
        rngDiff.Interior.Color = 9944773
 
    End If
 
    Set rngDiff = Nothing
 
End Sub
 
 
 
Public Function DeltaRange(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
 
 
 
    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 getCellCount(rng1) < 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 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 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 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 AppendToRange(rngUnion, rngRightCols)
 
        End If
 
    End If
 
    Set DeltaRange = rngUnion
 
    GoTo ExitH
 
ErrH:
 
    MsgBox strMsg, vbInformation, ".::Error::."
 
    Set DeltaRange = 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 Function getCellCount(rng As Range) As Double
 
    Dim dblRowCount     As Double
 
    Dim dblColCount     As Double
 
 
 
    dblRowCount = rng.Rows.Count
 
    dblColCount = rng.Columns.Count
 
    getCellCount = dblRowCount * dblColCount
 
 
 
    dblRowCount = Empty
 
    dblColCount = Empty
 
End Function
 
 
 
Private Sub 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