75K Non-Contiguous Areas, No Problem
My FastUnion class was able to crack the 75K non-contiguous areas goal by expanding on Ahmed AU answer using Union()
with multiple parameters. Although, this class excels at smaller numbers of areas, my UnionCollection class far out performs it by working with smaller groups of cells at a time.

Results
Immediate Window ScreenShot
FastUnion:Class
Option Explicit
Private Const MaxArgs As Long = 30
Private Groups(1 To MaxArgs) As Range
Private Index As Long
Private Count As Long
Private Compacted As Boolean
Public Sub Add(ByRef NewRange As Range)
If Count < MaxArgs Then Count = Count + 1
Index = Index + 1
If Index > MaxArgs Then Index = IIf(Compacted, 2, 1)
If Groups(Index) Is Nothing Then
Set Groups(Index) = NewRange
Else
Set Groups(Index) = Union(Groups(Index), NewRange)
End If
End Sub
Private Sub Compact()
Select Case Count
Case 2
Set Groups(1) = Union(Groups(1), Groups(2))
Case 3
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3))
Case 4
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4))
Case 5
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5))
Case 6
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6))
Case 7
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7))
Case 8
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8))
Case 9
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9))
Case 10
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10))
Case 11
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11))
Case 12
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12))
Case 13
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13))
Case 14
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14))
Case 15
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15))
Case 16
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16))
Case 17
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17))
Case 18
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18))
Case 19
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19))
Case 20
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20))
Case 21
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21))
Case 22
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22))
Case 23
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23))
Case 24
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23), Groups(24))
Case 25
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23), Groups(24), Groups(25))
Case 26
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23), Groups(24), Groups(25), Groups(26))
Case 27
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23), Groups(24), Groups(25), Groups(26), Groups(27))
Case 28
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23), Groups(24), Groups(25), Groups(26), Groups(27), Groups(28))
Case 29
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23), Groups(24), Groups(25), Groups(26), Groups(27), Groups(28), Groups(29))
Case 30
Set Groups(1) = Union(Groups(1), Groups(2), Groups(3), Groups(4), Groups(5), Groups(6), Groups(7), Groups(8), Groups(9), Groups(10), Groups(11), Groups(12), Groups(13), Groups(14), Groups(15), Groups(16), Groups(17), Groups(18), Groups(19), Groups(20), Groups(21), Groups(22), Groups(23), Groups(24), Groups(25), Groups(26), Groups(27), Groups(28), Groups(29), Groups(30))
End Select
Dim n As Long
For n = 2 To MaxArgs
Set Groups(n) = Nothing
Next
Index = 2
Compacted = True
Count = 0
End Sub
Public Function getRange() As Range
Compact
Set getRange = Groups(1)
End Function
UnionCollection:Class
The Default number of cells in a group is set to 500 which may not be optimal. The optimal group size could be determined by testing different values for the CellCountGoal
.
Option Explicit
Private Const DefaultCellCountGoal As Long = 500
Private RangeItems As New Collection
Private item As Range
Public CellCountGoal As Long
Public Sub Add(ByRef NewRange As Range)
If item Is Nothing Then
Set item = NewRange
Else
Set item = Union(item, NewRange)
End If
If item.CountLarge >= CellCountGoal Then Compact
End Sub
Private Sub Class_Initialize()
CellCountGoal = DefaultCellCountGoal
End Sub
Public Function Items() As Collection
Compact
Set Items = RangeItems
End Function
Private Sub Compact()
If Not item Is Nothing Then
RangeItems.Add item
Set item = Nothing
End If
End Sub
Module1
Option Explicit
Sub TestFastUnion()
Application.ScreenUpdating = False
Debug.Print "TestFastUnionRange Results:"
Debug.Print "Area Count", "UnionTime", "FormatTime", "ProcTime"
TestFastUnionRange 1000, 2000, 3000, 5000, 10000, 75000
Debug.Print
Debug.Print "TestUnionCollection Results:"
Debug.Print "Area Count", "UnionTime", "FormatTime", "ProcTime"
TestUnionCollection 1000, 2000, 3000, 5000, 10000, 75000
End Sub
Sub TestFastUnionRange(ParamArray AreaCounts() As Variant)
Dim AllCells As Range, Cell As Range
Dim ProcTime As Double, FormatTime As Double, UnionTime As Double
Dim NewUnion As FastUnion
Dim AreaCount
For Each AreaCount In AreaCounts
Cells.ClearFormats
Debug.Print AreaCount,
ProcTime = Timer
Set NewUnion = New FastUnion
For Each Cell In Range("A1").Resize(AreaCount * 2)
If Cell.Row Mod 2 = 0 Then NewUnion.Add Cell
Next
Set AllCells = NewUnion.getRange
UnionTime = Round(Timer - ProcTime, 2)
ApplyBorderFormmating AllCells, vbRed
ProcTime = Round(Timer - ProcTime, 2)
FormatTime = Round(ProcTime - UnionTime, 2)
Debug.Print UnionTime, FormatTime, ProcTime
Next
End Sub
Sub TestUnionCollection(ParamArray AreaCounts() As Variant)
Dim Cell As Range, item As Range
Dim ProcTime As Double, FormatTime As Double, UnionTime As Double
Dim NewUnion As UnionCollection
Dim AreaCount
For Each AreaCount In AreaCounts
Cells.ClearFormats
Debug.Print AreaCount,
ProcTime = Timer
Set NewUnion = New UnionCollection
For Each Cell In Range("A1").Resize(AreaCount * 2)
If Cell.Row Mod 2 = 0 Then NewUnion.Add Cell
Next
UnionTime = Round(Timer - ProcTime, 2)
For Each item In NewUnion.Items
ApplyBorderFormmating item, vbRed
Next
ProcTime = Round(Timer - ProcTime, 2)
FormatTime = Round(ProcTime - UnionTime, 2)
Debug.Print UnionTime, FormatTime, ProcTime
Next
End Sub
Sub ApplyBorderFormmating(Target As Range, Color As Single)
With Target.Borders
.Color = Color
.LineStyle = xlContinuous
.Weight = xlThick
End With
End Sub
Sub PrintCases()
Dim list As Object
Set list = CreateObject("System.Collections.ArrayList")
Dim n As Long
For n = 1 To 30
list.Add "Groups(" & n & ")"
Debug.Print String(2, vbTab); "Case "; n
Debug.Print String(3, vbTab); "Set AllCells = Union("; Join(list.ToArray, ","); ")"
Next
End Sub
Edit
I modified the FastUnion class after I realized it would reset the range after Compact()
was ran.
The OP pointed out I should list my specs.
System Specs
- 64 bit Office 365
- 6 GB Ram
- 2.3 MHz processor
Addendum
Here was my first attempt at cracking 75 K areas. It performed very well with smaller number of unions but started to slow down exponentially after 20 K unions. Although, it probably isn't practical, there may be some merit to combining it with the FastUnion. If nothing else it was interesting to write.
StingUnion:Class
Option Explicit
Private Const MaxAddressSize As Long = 255
Private CurrentLength As Long
Private Result As Range
Private Parent As Worksheet
Private AddressHolder As String
Public Sub Add(Source As Range)
If Parent Is Nothing Then
Set Parent = Source.Parent
AddressHolder = Space(MaxAddressSize)
End If
Dim length As Long
Dim Address As String
Address = Source.Address(0, 0)
length = Len(Address)
If (length + CurrentLength) > MaxAddressSize Then Compact
If CurrentLength = 0 Then
Mid(AddressHolder, CurrentLength + 1, length + 1) = Address
Else
Mid(AddressHolder, CurrentLength + 1, length + 1) = "," & Address
End If
CurrentLength = CurrentLength + length + 1
End Sub
Public Sub Compact()
If CurrentLength = 0 Then Exit Sub
If Result Is Nothing Then
Set Result = Parent.Range(AddressHolder)
Else
Set Result = Union(Result, Parent.Range(AddressHolder))
End If
CurrentLength = 0
AddressHolder = Space(MaxAddressSize)
End Sub
Function getRange() As Range
Compact
Set getRange = Result
End Function
UNION
function. It looks like the post on SO was possibly based on this site, and it's instructive to review the limitations lower down on that page. Also, Craig Pearson has an excellent updatedProperUnion
function that addresses many of the limitations. \$\endgroup\$Union
limit may be 2,147,483,648 cells (see "Noncontiguous cells that can be selected"). But I'm not convinced that is the correct number. In any case, I completely agree with the other answers on SO that the correct approach is conditional formatting. \$\endgroup\$