Two new range functions: Union and Subtract

Posted on by Tushar Mehta

This post discusses two functions I developed because of a recent need. The first is an enhanced version of the Excel Union method. The other is a Subtract function that operates on ranges.

The Union function

Those who use the Excel Application’s Union method with any sense of regularity know it doesn’t deal well with any argument being ‘nothing.’ Consequently, it is almost second nature to code

Recently, I found myself writing the above code for the 3rd time in a few days. Annoyed at not having modularized it years ago, I did just that. It’s below.

With the above, one can code the below without worrying about whether Rslt or NextCell is Nothing.

True, unlike the Union method, the function accepts only 2 arguments. I did write a more generic function declared with a ParamArray argument only to discover that the Union method won’t accept a single variant (‘argument not optional’ error) or an array (‘type mismatch’ error). Maybe someone else can make the more generic case work.

The Range Subtract function

I also had reason to write a Subtract function. Given two ranges, Rng1, and Rng2, where Rng2 is a subset of Rng1, the result is Rng1 – Rng2, i.e., all those cells in Rng1 that are not part of Rng2.

I remembered a post by Tom Ogilvy from a long time ago that used the following method: In a temporary worksheet, in the range corresponding to the address of Rng1 enter some constant (say the value 1). Next, clear the cells corresponding to the address of Rng2, and finally, pick up the result with the SpecialCells method.

The above is probably as efficient as one can get but concerned about issues such as write privileges, multiple people accessing an add-in on a network drive, etc., I wrote up a solution from first principles, as it were.

The advantage of working from first principles is that it works correctly irrespective of the shape of the two arguments Rng1 and Rng2. We don’t have to worry about whether they consist of multiple areas or not. The disadvantage, of course, is that it checks each cell in Rng1 and consequently might be slow under certain circumstances.

Before proceeding further, one should remember that the need for any optimization is unproven. I don’t know what, if any, problems the first solution will run into nor do I know how slow the solution based on first principles will be. So, the benefits of the optimizations below are somewhat uncertain. By contrast, it is certain that there will be some cost to developing the code, testing it, and maintaining it.

The first step in optimization would be to start small: a single area from which we want to subtract a single area. Clearly, in this case the result will be at the most four ranges as shown below. The first image shows the area that we want to subtract in yellow. The second image shows the four areas that will remain after the subtraction operation is completed.
Rng1 is the entire range shown; Rng2, the range we want to subtract, is in yellow.
The result of the subtraction is four ranges. It would be three if the range to be subtracted touched one of the edges, and just two if it was in a corner.

The code below is a function that accepts two range arguments Rng1 and Rng2 and returns a range that corresponds to Rng1 – Rng2. It validates that each range consists of a single area. I don’t know what it means to subtract Rng2 from Rng1 if there is absolutely no overlap between the two ranges. So, I made the assumption that the result should be Rng1 itself. Before proceeding with the analysis, the code computes what part of Rng2 is actually within Rng1. Each of the four If statements enclose a block of code that calculates one of the four possible ranges in the result (see the above image). Finally, the code returns the result of the subtraction.

With the building block in place, writing the Subtract function to calculate Rng1 – Rng2 is a lot easier. All we need to do is accumulate the result as we loop through each area of Rng1 and subtract from it each area of Rng2.

The code is used as in the following example:

At some point a variant of the above will show up in the “publications and training” section of my web site.

And, that concludes all I have to share on this subject…at least for the time being.

Posted in Uncategorized

30 thoughts on “Two new range functions: Union and Subtract”

  1. Hi Tushar,

    How about this for a multi argument union?

    Sub TestUnion()

        Dim rngA As Range
        Dim rngB As Range
        Dim rngC As Range
        Dim rngD As Range
       
        Set rngA = Range(“A1:B5”)
        Set rngB = Range(“A3:E4”)
        Set rngD = Range(“D2:D10”)
       
        Union(rngA, rngB, rngC, rngD).Select
        Debug.Print Selection.Address
       
    End Sub
    Function Union(ParamArray Rngs()) As Range
       
        Dim rngUnion As Range
        Dim vntX As Variant
       
        For Each vntX In Rngs
            If Not vntX Is Nothing Then
                If rngUnion Is Nothing Then
                    Set rngUnion = vntX
                Else
                    Set rngUnion = Application.Union(rngUnion, vntX)
                End If
            End If
        Next
           
        If Not rngUnion Is Nothing Then Set Union = rngUnion

    End Function

  2. Minor technicality, I might have named the second function Remove or RangeRemove rather than Subtract, which is too strongly linked with the mathematical operation. The approach itself is nicely done.

  4. Tushar,
    Unrelated to the functions above, just wanted to send a quick hi; never realized before that we’re neighbors (though I live downtown, I used to spend quite a bit of time in RV). Keep up the good work!

  6. Andy: You’ll need more testing on the ParamArray, as users will no doubt pass the unexpected.
    For Each vRng In Rngs
    If IsObject(vRng) Then
    If Not vRng Is Nothing Then
    If TypeOf vRng Is Range Then

  7. keepITcool: Your right I did not include code to check arguments where indeed ranges.
    But the post was just to point Tushar in the right direction ;)

  8. FWIW, my version of Union with argument checking.

    Function fcnUnion( _
     strict As Boolean, _
     ParamArray a() As Variant _
    ) As Range
    ‘—————————–
      Dim v As Variant, r As Range

      For Each v In a
        If Not IsObject(v) Then
          GoTo Fail

        ElseIf v Is Nothing Then
          If strict Then GoTo Fail

        ElseIf Not TypeOf v Is Range Then
          GoTo Fail

        ElseIf fcnUnion Is Nothing Then
          Set fcnUnion = v

        Else
          Set r = v
          Set fcnUnion = Union(fcnUnion, r)

        End If

      Next v

      Exit Function

    Fail:
      Set fcnUnion = Nothing

    End Function

    Arguable whether it should return an error value when it finds non-Range arguments rather than returning Nothing.

    As for the pseudo nonsymmetric set difference of a range with a single area range, i.e., removing the single area range from another, more general range, A B = Intersect(A, Complement(B)), and the complement of a single area range B is the union of rows above B, rows below B, columns to the left of B and columns to the right of B. Also, if A and B are disjoint, A B = A.

    ‘simple > and < comparisons replaced with Sgn(..) = 1
    ‘comparisons in order to please the fine blog software
    Function fcnRangeRemoveSA(a As Range, b As Range) As Range
      Dim i(1 To 4) As Long, w(1 To 2) As Long
      Dim ct As Range, cb As Range, cl As Range, cr As Range

      If Intersect(a, b) Is Nothing Then
        Set fcnRangeRemoveSA = a
        Exit Function
      End If

      w(1) = b.Parent.Rows.Count
      w(2) = b.Parent.Columns.Count

      i(1) = b.Row – 1
      i(2) = b.Row + b.Rows.Count
      i(3) = b.Column – 1
      i(4) = b.Column + b.Columns.Count

      With b.Parent
        If Sgn(i(1)) = 1 Then _
         Set ct = .Range(Cells(1, 1), Cells(i(1), w(2)))

        If Sgn(w(1) – i(2)) = 1 Then _
         Set cb = .Range(Cells(i(2), 1), Cells(w(1), w(2)))

        If Sgn(i(3)) = 1 Then _
         Set cl = .Range(Cells(1, 1), Cells(w(1), i(3)))

        If Sgn(w(2) – i(4)) = 1 Then _
         Set cb = .Range(Cells(1, i(4)), Cells(w(1), w(2)))

      End With

      Set fcnRangeRemoveSA = Intersect(a, _
       fcnUnion(False, ct, cb, cl, cr))

    End Function

    The complement of a multiple area range is the intersection of the complements of each area.

  9. Just noticed the fine blog software doesn’t display the VBA keyword With in blue text. Does it not consider With a VBA keyword?

  10. And a bug in the 4th If statement inside the With block in the second function. It should be

        If Sgn(w(2) – i(4)) = 1 Then _
         Set cr = .Range(Cells(1, i(4)), Cells(w(1), w(2)))

  12. Very neatly done – and pretty much exactly what I was looking for.
    A related function that I have written in the past couple of days is:

    Function RangeOffset(myRange As Range, Optional offsetRow As Integer, Optional offsetCol As Integer) As Range
    ‘Takes in a range object and reduces it in size by taking rows off the top, bottom, left, or right.
    ‘Works by doing an intersection of a range with an offset of that range.

        Set RangeOffset = Application.Intersect(myRange, myRange.Offset(offsetRow, offsetCol))

    End Function

    It’s not quite robust enough for general purpose use – if the range is an entire row and you want only the first 255 columns, for example, ideally you would say

    RangeOffset(myRowRange,,-1)

    but this causes an error. Which is how I came to find this page.
    If anyone has got any suggestions for making my code slightly more robust I’d appreciate it.

    Regards,
    Bruce.

  13. Tushar — Thanks for posting this solve. Saved me an evening of hair pulling!

    I think I found a quick issue — If Rng2 and Rng1 share the same top left cell, the subtractOneArea procedure will fail at:

    If Rng2.Row + Rng2.Rows.Count < Rng1.Row + Rng1.Rows.Count Then
            Set Rslt = Union(Rslt, _
                WS.Range(Rng1.Rows(Rng2.Row – Rng1.Row + Rng2.Rows.Count + 1), _
                    Rng1.Rows(Rng1.Rows.Count)))
            End If

    Because Rslt has yet to be set. Replacing the above section with the following seems to do the trick:

     If Rng2.Row + Rng2.Rows.Count < Rng1.Row + Rng1.Rows.Count Then
            If Rslt Is Nothing Then
              Set Rslt = WS.Range(Rng1.Rows(Rng2.Row – Rng1.Row + Rng2.Rows.Count + 1), _
                    Rng1.Rows(Rng1.Rows.Count))
            Else
              Set Rslt = Union(Rslt, _
                  WS.Range(Rng1.Rows(Rng2.Row – Rng1.Row + Rng2.Rows.Count + 1), _
                      Rng1.Rows(Rng1.Rows.Count)))
            End If
            End If

    Hope this is helpful..

    Sean

  14. Hello,

    This is a great forum. I am looking for something similar to the concepts discussed on this page. I need to copy & paste a large range from one workbook to another, but exclude certain list of cells (e.g., specified as a list by the user, can be either entered in dialog box, or read from a 3rd sheet). The excluded cells would leave existing data untouched on the target sheet.

    Is there any elegant way to do this, other than one-at-a-time cell-to-cell copy? I need to do this once or twice, every month, so execution speed is not a major issue.

    Rich

  18. @Rich Sulin,

    If the workbook is not protected, then you can use the subroutine below to do what you asked without visiting each cell individually. If the workbook is protected, and if you have the password, then you can add the appropriate code to the subroutine below in order to remove it, execute the code, then reestablish it. Note that this subroutine, as written, expects the source worksheet to be the active sheet when it is executed.

    Sub CopyWithExclusions(DestinationSheetName As String, LargeRangeCellAddress As String, _
                           ParamArray ExclusionCellAddresses() As Variant)
      Dim Addr As Variant, CopyRangeAddresses As String, Ar As Range, WS As Worksheet
      Set WS = ActiveSheet
      Application.ScreenUpdating = False
      With Sheets.Add
        .Range(LargeRangeCellAddress).Value = “X”
        For Each Addr In ExclusionCellAddresses
          .Range(Addr).Clear
        Next
        CopyRangeAddresses = .Cells.SpecialCells(xlCellTypeConstants).Address
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
      End With
      For Each Ar In WS.Range(CopyRangeAddresses)
        Worksheets(DestinationSheet).Range(Ar.Address).Value = Ar.Value
      Next
      Application.ScreenUpdating = True
    End Sub

    A sample call to this subroutine might look like this (assumed to be run from any sheet other than Sheet2)…

    Sub Test()
      CopyWithExclusions “Sheet2”, “B3:M28”, “D4:F6”, “F17:F22”, “I8:K8”, “L21:M25”
    End Sub

    Note that this same concept (insert a sheet, fill/clear ranges as required) can be used to create (non-UDF) functions to return “pure” unions and “pure” non-interesected ranges. Doing it this way would overcome the slowness of performing multiple unions and also eliminate the double counting of cells the result from “unioning” ranges that overlap. Anyway, it’s just an idea.

  20. @Tushar – Whoops! It looks like I went and reinvented the wheel. (°o°)

  21. Strange, the less-than and greater-than characters didnt appear above. In two places it should be:
    If SkipList LT GT “” Then…

    (I had to type as letters here to get it to appear)

  22. @Rich Sulin,

    You need to use one of the set of code tags listed above the “Leave a Reply” (in blue letters) located above where your name goes when posting a reply. Namely, for your VB code…

    Your code goes here

  23. Well duh! Of course, using the tags in my last reply created the code box rather than display the code tag’s text. So much for my demo :-)

  24. (Webmaster, please delete my previous post)
    Thanks Tushar, Rick and Dick, I will try these other ideas when I get a chance. For the sake of others who might be reading this thread, here is what I originally did:

    Calling program:

    Public Sub vCopyAndPasteWithExceptions_Go()
     Load CopyAndPasteWithExceptions
     CopyAndPasteWithExceptions.Show
    End Sub

    User form code:

    Private Sub Execute_Click()
     ‘User form: CopyAndPasteWithExceptions
     ‘Form has range-entry controls that provide SourceRange, TargetRange, SkipList, and
     ‘a checkbox for CheckBox1 (Include formatting?)
     ‘
     ‘User clicked on “Execute” button….
     vCopyPasteWithExceptions Me.SourceRange, Me.TargetRange, Me.SkipList, Me.CheckBox1
     Unload Me
    End Sub

    Main program, called by user form:

    Public Sub vCopyPasteWithExceptions(SourceRange As String, TargetRange As String, _
                SkipList As String, IncludeFormating As Boolean)
     ‘ Called by User form: CopyAndPasteWithExceptions
     ‘ v1 Rich Sulin 08-15-2011

     Dim i As Long, n As Long
     Dim oSource As Object
     Dim oTarget As Object
     Dim oExcept As Object
     Dim oTemp As Object

     Set oSource = Range(SourceRange)
     Set oTarget = Range(TargetRange)
     If SkipList “” Then Set oExcept = Range(SkipList)

     n = oSource.Cells.Count
     Application.ScreenUpdating = False ‘speed up process, turn off screen updates

     ‘Copy the formulas
     For i = 1 To n
       If SkipList “” Then Set oTemp = Application.Intersect(oTarget(i), oExcept)
       If oTemp Is Nothing Then
          If IncludeFormating Then
             oSource(i).Copy oTarget(i)
          Else
             oSource(i).Copy
             oTarget(i).PasteSpecial xlPasteFormulas
          End If
       End If

     Application.StatusBar = “Done: ” & Format(i / n, “##0%”) ‘progress, visual feedback

     Next i

     Application.ScreenUpdating = True
     Application.StatusBar = False
    End Sub

  25. Pingback: Selection minus ActiveCell
  26. Pingback: exclude a range from another range

  27. The above routines need (I feel) to test whether the ranges being compared are on the same worksheet or not. I think this is just as important as testing isObject or isNothing.

  28. As a special case, when one range is wholly within another, subtract the smaller from the larger:

  29. Oh, I need to add the following two lines

    before this line

  30. Oh yeah, not equal is not a tag. Update this line:

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.