Improving The Union Function

This page describes alternatives to VBA's Union function.

Introductcion

Excel/VBA's Union method is used to combine two ranges into a single range. For example,

     Dim RR As Range
    Set RR = Applicaiton.Union(Range("A1:A10"),Range("B1:B10"))
    

This combines A1:A10 and B1:B10 into a single range, RR, which now references A1:B10.

The Union method, though, has two shortcomings. First, none of its input parameters may be Nothing. If any parameter is Nothing, the Union operation fails. A better union, described below, will ignore parameters that are Nothing and uses only the parameters that not Nothing to create the new range. The second shortcoming of Union is that it duplicates cells when the regions specified by the input parameters overlap. This can cause logic problems in your code since overlapping cells are included twice in the Union result.

Allowing Union To Handle Nothing Parameters

Union does not allow any parameters to be Nothing. For example, the Union method in the code below will raise an error 5, Invalid Procedure Call because R3 is Nothing.

         Dim R1 As Range
        Dim R2 As Range
        Dim R3 As Range
        Dim RR As Range
        Set R1 = Range("A1")
        Set R2 = Range("B1")
        Set RR = Application.Union(R1, R2, R3)' Error 5 - Invalid Parameter
    

A better UnionR33 parameter since it is Nothing. The following function allows for parameters that are Nothing.

    Function Union2(ParamArray Ranges() As Variant) As Range
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Union2
    ' A Union operation that accepts parameters that are Nothing.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim N As Long
        Dim RR As Range
        For N = LBound(Ranges) To UBound(Ranges)
            If IsObject(Ranges(N)) Then
                If Not Ranges(N) Is Nothing Then
                    If TypeOf Ranges(N) Is Excel.Range Then
                        If Not RR Is Nothing Then
                            Set RR = Application.Union(RR, Ranges(N))
                        Else
                            Set RR = Ranges(N)
                        End If
                    End If
                End If
            End If
        Next N
        Set Union2 = RR
    End Function
    

By using Union2 the code above will work, setting RR to reference A1:B10. Since R3 is Nothing, the code ignores it rather than raising an error.

        Dim R1 As Range
        Dim R2 As Range
        Dim R3 As Range
        Dim RR As Range
        Set R1 = Range("A1")
        Set R2 = Range("B1")
        Set RR = Union2(R1, R2, R3) ' success
    

Handling Duplicates In A Union

If two or more of the parameters to Union overlap, the overlapping cells are counted twice (or more). For example, consider the following code:

    Dim RR As Range
    Set RR = Application.Union(Range("A1:C3"), Range("B3:D5"))
    Debug.Print RR.Address(False, False), RR.Cells.Count
    

Each of the two ranges contain 9 cells, so Union result returns 18 cells. But the two ranges overlap, and the overlapping cells B3 and C3 are counted twice. A proper count of cells shows that there are 16, not 18, cells in the combined range. A loop through the cells iterates 18, not 16, times.

    Dim RR As Range
    Dim R As Range
    Dim N As Long
    Set RR = Application.Union(Range("A1:C3"), Range("B3:D5"))
    For Each R In RR
        N = N + 1
    Next R
    Debug.Print N ' 18 cells. incorrect
    

A better Union would not duplicate cells. Such a function, named ProperUnion is shown below:

     Function ProperUnion(ParamArray Ranges() As Variant) As Range
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ProperUnion
    ' This provides Union functionality without duplicating
    ' cells when ranges overlap. Requires the Union2 function.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim ResR As Range
        Dim N As Long
        Dim R As Range
        
        If Not Ranges(LBound(Ranges)) Is Nothing Then
            Set ResR = Ranges(LBound(Ranges))
        End If
        For N = LBound(Ranges) + 1 To UBound(Ranges)
            If Not Ranges(N) Is Nothing Then
                For Each R In Ranges(N).Cells
                    If Application.Intersect(ResR, R) Is Nothing Then
                        Set ResR = Union2(ResR, R)
                    End If
                Next R
            End If
        Next N
        Set ProperUnion = ResR
    End Function
    

Using the code above but calling ProperUnion instead of Union, the correct range and cell count is calculated as the combined range.

    Dim RR As Range
    Dim R As Range
    Dim N As Long
    Set RR = ProperUnion(Range("A1:C3"), Range("B3:D5"))
    For Each R In RR
        N = N + 1
    Next R
    Debug.Print N ' 16 cells. correct    
    

The ProperUnion function can accept up to 30 parameters. As written, it uses the Union2 function described above, but you could easily incorporate the functionality of Union2 directly into ProperUnion, eliminating the function call.

This page last updated: 12-January-2011.