Daily Dose of Excel

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

Sub RoundAboutCode()
    Dim Rng1 As Range, Rng2 As Range, Rslt As Range
    ‘…
    If Rng1 Is Nothing Then
        Set Rslt = Rng2
    ElseIf Rng2 Is Nothing Then
        Set Rslt = Rng1
    Else
        Set Rslt = Application.Union(Rng1, Rng2)
        End If
    End Sub

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.

Function Union(Rng1 As Range, Rng2 As Range) As Range
    If Rng1 Is Nothing Then
        Set Union = Rng2
    ElseIf Rng2 Is Nothing Then
        Set Union = Rng1
    Else
        Set Union = Application.Union(Rng1, Rng2)
        End If
    End Function

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

        Set Rslt = Union(Rslt, NextCell)

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.

Function SubtractUsingWS(Rng As Range, RngToSubtract As Range)
    If Application.Intersect(Rng, RngToSubtract).Address _
        <> RngToSubtract.Address Then Exit Function

    Dim OldEventsValue
    OldEventsValue = Application.EnableEvents
    Application.EnableEvents = False
    On Error GoTo Finally1

    With ThisWorkbook.Worksheets(”TempWS”)
    .Cells.ClearContents
    .Range(Rng.Address).Value = 1
    .Range(RngToSubtract.Address).ClearContents
    Set SubtractUsingWS = _
        Rng.Parent.Range(.Cells.SpecialCells(xlCellTypeConstants).Address)
        End With
    ThisWorkbook.Saved = True
Finally1:
    Application.EnableEvents = OldEventsValue
    End Function

Sub testSubtract2()
    MsgBox SubtractUsingWS(Range(”a1:C3″), Range(”b2″)).Address
    End Sub

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.

Function SubtractFirstPrinciples(Rng1 As Range, Rng2 As Range) As Range
    On Error Resume Next
    If Application.Intersect(Rng1, Rng2).Address <> Rng2.Address Then _
        Exit Function
    On Error GoTo 0
    Dim aCell As Range
    For Each aCell In Rng1
        Dim Rslt As Range
        If Application.Intersect(aCell, Rng2) Is Nothing Then
            Set Rslt = Union(Rslt, aCell)
            End If
        Next aCell
    Set SubtractFirstPrinciples = Rslt
    End Function

Sub testSubtractFirstPrinciples()
    Debug.Print SubtractFirstPrinciples( _
        Sheets(1).Range(”A1:f10″), _
        Sheets(1).Range(”A1,b2,c3,d4:e5,f6″)).Address
    End Sub

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.

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.

Function subtractOneArea(Rng1 As Range, inRng2 As Range) As Range
    If Rng1.Areas.Count > 1 Then Exit Function
    If inRng2.Areas.Count > 1 Then Exit Function
    If Application.Intersect(Rng1, inRng2) Is Nothing Then
        Set subtractOneArea = Rng1
        Exit Function
        End If
    Dim Rng2 As Range
    Set Rng2 = Application.Intersect(Rng1, inRng2)
    Dim aRng As Range, OKRng As Range, Rslt As Range, WS As Worksheet
    Set WS = Rng1.Parent
    If Rng2.Row > Rng1.Row Then
        Set Rslt = WS.Range(Rng1.Rows(1), Rng1.Rows(Rng2.Row - Rng1.Row))
        End If
    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
    If Rng2.Column > Rng1.Column Then
        Set Rslt = Union(Rslt, WS.Range(WS.Cells(Rng2.Row, Rng1.Column), _
            WS.Cells(Rng2.Row + Rng2.Rows.Count - 1, Rng2.Column - 1)))
       End If
    If Rng2.Column + Rng2.Columns.Count < Rng1.Column + Rng1.Columns.Count Then
        Set Rslt = Union(Rslt, _
            WS.Range(WS.Cells(Rng2.Row, Rng2.Column + Rng2.Columns.Count), _
                WS.Cells(Rng2.Row + Rng2.Rows.Count - 1, _
                    Rng1.Column + Rng1.Columns.Count - 1)))
        End If
    Set subtractOneArea = Rslt
    End Function

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.

Function Subtract(Rng1 As Range, Rng2 As Range) As Range
    On Error Resume Next
    If Application.Intersect(Rng1, Rng2).Address <> Rng2.Address Then _
        Exit Function
    On Error GoTo 0
    Dim Rslt As Range, Rng1Rslt As Range, J As Integer, I As Integer
    For J = 1 To Rng1.Areas.Count
        Set Rslt = subtractOneArea(Rng1.Areas(J), Rng2.Areas(1))
        For I = 2 To Rng2.Areas.Count
            Set Rslt = Application.Intersect( _
                Rslt, subtractOneArea(Rng1.Areas(J), Rng2.Areas(I)))
            Next I
        Set Rng1Rslt = Union(Rng1Rslt, Rslt)
        Next J
    Set Subtract = Rng1Rslt
    End Function

The code is used as in the following example:

Sub testSubtract()
    Debug.Print Subtract( _
        Sheets(1).Range(”A1:f10″), _
        Sheets(1).Range(”A1,b2,c3,d4:e5,f6″)).Address
    Debug.Print Subtract( _
        Sheets(1).Range(”A1:f9,a10:f10″), _
        Sheets(1).Range(”A1,b2,c3,d4:e5,f6″)).Address
    Debug.Print Subtract( _
        Sheets(1).Range(”$I$1:$K$4,$L$4:$N$8,$K$7:$K$13″), _
        Sheets(1).Range(”$K$4:$L$4,$K$8:$L$8″)).Address
    End Sub

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.