Brute force looping & formatting Or Create Union range & Format? Which is efficient and when?

Question

May be my question is not up to the standard for Code Review, but of upmost importance for reassessing methods used in my VBA coding . While preparing/testing answer for a SO post (thought to simplest of simplest questions) VBA cell format that contain a specific percentage value, I came to a jolt that shaken whatever little confidence I had in VBA.

I found that OP had looped more than once in the cells of Range in question and used to select each cell and test its value and then format border of the cell with desired parameters. As a thumb rule to minimize interaction with excel cell and to avoid select etc, I simply planned for go for each cell iteration of the range and test the values and according to make a union range object and finally format that range in a single go.

Actually I am ashamed about the code and don’t want to reproduce it here and only concerned about the methods suitable for this type of operation. However since code review rule calls for at least 3 lines of code I am forced to paste (the never going to be finished) code here and request to ignore completely.

Sub test()
Dim lr As Long
Dim c As Range, Rng As Range, Grt100Rng As Range, Less0Rng As Range
lr = Range("G" & Rows.Count).End(xlUp).Row
Set Rng = Range("G3:G" & lr)  
Dim tm As Double
tm = Timer
    For Each c In Rng
        If c >= 1 Then
            If Grt100Rng Is Nothing Then
            Set Grt100Rng = c
            Else
            Set Grt100Rng = Union(Grt100Rng, c)
            End If
        End If
        If c <= 0 Then
            If Less0Rng Is Nothing Then
            Set Less0Rng = c
            Else
            Set Less0Rng = Union(Less0Rng, c)
            End If
        End If
    Next

  Debug.Print "Union at :" & Timer - tm
  If Not Grt100Rng Is Nothing Then
  With Grt100Rng.Borders
  If GreaterThan100.Value Then
  .Color = vbBlue
  .LineStyle = xlContinuous
  .Weight = xlThick
  Else
  .Color = vbBlack
  .LineStyle = xlNone
  .Weight = xlThin
  End If
  End With


  With Less0Rng.Borders
  If LessThan0.Value Then
  .Color = vbBlue
  .LineStyle = xlContinuous
  .Weight = xlThick
  Else
  .Color = vbBlack
  .LineStyle = xlNone
  .Weight = xlThin
  End If
  End With
  End If
  Debug.Print Timer - tm
End Sub

Similar working approach already tried successfully in my SO answer referred below. But this time, the above code cruelly backfired on me and taken around 80 sec for processing 10 k rows.

Testing the values of the range from a 2D Array taken in single command ( Arr=Rng.value) from the range object and tried to create union range from the array row address took nearly same amount of time. When tested the OP code found it takes only 12-14 sec to process with screen updating on and 1.2 sec with screen updating off.

I refrain from answering the post leaving comments to help OP to create Conditional format. I somehow realized (or rather conceptualize ) reading and formatting cells would be faster than creating union range and union range would only prove better option when writing cells,

I started testing on new Range of 10-50 K rows various option to find optimized condition when creating Union range would be efficient over brute force looping and formatting cell. At testing of 10 K rows I start finding union method is being far less efficient than brute force looping. At 50 K it never finished the process.

As the testes are being time consuming I thought of asking for experts opinion in Code Review and get what would be the optimized scenario for creating using union range for conditional formatting (in VBA) over brute force looping and formatting.

In this context, I must refer to my answer in SO post Is it possible to speed-up background / text / border formatting?. In this case, Union Range method reduced process time to a odd second from around 30 minutes.

If auto filtering and creating range of SpecialCells(xlCellTypeVisible) is a solution, that also proved to raise error 1004 "Ms excel cannot create or use data range reference because too complex” at around range of 150 K rows. Tried and failed at SO Post. What is the limitation of Union range?

It made my confidence shaken. May some experts please clarify, If union range method is always less efficient, why this above referred answer brought down the time to a odd second from around 30 minutes. Any explanation,advice, good reading or information on the matter would be a bonanza.

Edit: I want to share the result of simple tests carried out today to test limit of creating range of SpecialCells(xlCellTypeVisible). To keep the original post length readable, I am deleting this section and posting it as answer.

Answer 1

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

Answer 2

I am not saying how this is going to help, but I did the Same test on My system (Office 2010) couldn't find 2007.

So for the Test of the Range SpecialCells(xlCellTypeVisible), it took less than a second in my system to complete the Range as in your Answer using the same code on a Blank sheet.

Result in Debug.

Success at 1000 Range Area Count 250
Success at 2000 Range Area Count 500
Success at 3000 Range Area Count 750
Success at 4000 Range Area Count 1000
Success at 5000 Range Area Count 1250
Success at 6000 Range Area Count 1500
Success at 7000 Range Area Count 1750
Success at 8000 Range Area Count 2000
Success at 9000 Range Area Count 2250
Success at 10000 Range Area Count 2500
Success at 11000 Range Area Count 2750
Success at 12000 Range Area Count 3000
Success at 13000 Range Area Count 3250
Success at 14000 Range Area Count 3500
Success at 15000 Range Area Count 3750
Success at 16000 Range Area Count 4000
Success at 17000 Range Area Count 4250
Success at 18000 Range Area Count 4500
Success at 19000 Range Area Count 4750
Success at 20000 Range Area Count 5000
Success at 21000 Range Area Count 5250
Success at 22000 Range Area Count 5500
Success at 23000 Range Area Count 5750
Success at 24000 Range Area Count 6000
Success at 25000 Range Area Count 6250
Success at 26000 Range Area Count 6500
Success at 27000 Range Area Count 6750
Success at 28000 Range Area Count 7000
Success at 29000 Range Area Count 7250
Success at 30000 Range Area Count 7500
Success at 31000 Range Area Count 7750
Success at 32000 Range Area Count 8000
Success at 33000 Range Area Count 8250
Success at 34000 Range Area Count 8500
Success at 35000 Range Area Count 8750
Success at 36000 Range Area Count 9000
Success at 37000 Range Area Count 9250
Success at 38000 Range Area Count 9500
Success at 39000 Range Area Count 9750
Success at 40000 Range Area Count 10000
Success at 41000 Range Area Count 10250
Success at 42000 Range Area Count 10500
Success at 43000 Range Area Count 10750
Success at 44000 Range Area Count 11000
Success at 45000 Range Area Count 11250
Success at 46000 Range Area Count 11500
Success at 47000 Range Area Count 11750
Success at 48000 Range Area Count 12000
Success at 49000 Range Area Count 12250
Success at 50000 Range Area Count 12500
Success at 51000 Range Area Count 12750
Success at 52000 Range Area Count 13000
Success at 53000 Range Area Count 13250
Success at 54000 Range Area Count 13500
Success at 55000 Range Area Count 13750
Success at 56000 Range Area Count 14000
Success at 57000 Range Area Count 14250
Success at 58000 Range Area Count 14500
Success at 59000 Range Area Count 14750
Success at 60000 Range Area Count 15000
Success at 61000 Range Area Count 15250
Success at 62000 Range Area Count 15500
Success at 63000 Range Area Count 15750
Success at 64000 Range Area Count 16000
Success at 65000 Range Area Count 16250
Success at 66000 Range Area Count 16500
Success at 67000 Range Area Count 16750
Success at 68000 Range Area Count 17000
Success at 69000 Range Area Count 17250
Success at 70000 Range Area Count 17500
Success at 71000 Range Area Count 17750
Success at 72000 Range Area Count 18000
Success at 73000 Range Area Count 18250
Success at 74000 Range Area Count 18500
Success at 75000 Range Area Count 18750
Success at 76000 Range Area Count 19000
Success at 77000 Range Area Count 19250
Success at 78000 Range Area Count 19500
Success at 79000 Range Area Count 19750
Success at 80000 Range Area Count 20000
Success at 81000 Range Area Count 20250
Success at 82000 Range Area Count 20500
Success at 83000 Range Area Count 20750
Success at 84000 Range Area Count 21000
Success at 85000 Range Area Count 21250
Success at 86000 Range Area Count 21500
Success at 87000 Range Area Count 21750
Success at 88000 Range Area Count 22000
Success at 89000 Range Area Count 22250
Success at 90000 Range Area Count 22500
Success at 91000 Range Area Count 22750
Success at 92000 Range Area Count 23000
Success at 93000 Range Area Count 23250
Success at 94000 Range Area Count 23500
Success at 95000 Range Area Count 23750
Success at 96000 Range Area Count 24000
Success at 97000 Range Area Count 24250
Success at 98000 Range Area Count 24500
Success at 99000 Range Area Count 24750
Success at 100000 Range Area Count 25000
Success at 101000 Range Area Count 25250
Success at 102000 Range Area Count 25500
Success at 103000 Range Area Count 25750
Success at 104000 Range Area Count 26000
Success at 105000 Range Area Count 26250
Success at 106000 Range Area Count 26500
Success at 107000 Range Area Count 26750
Success at 108000 Range Area Count 27000
Success at 109000 Range Area Count 27250
Success at 110000 Range Area Count 27500
Success at 111000 Range Area Count 27750
Success at 112000 Range Area Count 28000
Success at 113000 Range Area Count 28250
Success at 114000 Range Area Count 28500
Success at 115000 Range Area Count 28750
Success at 116000 Range Area Count 29000
Success at 117000 Range Area Count 29250
Success at 118000 Range Area Count 29500
Success at 119000 Range Area Count 29750
Success at 120000 Range Area Count 30000
Success at 121000 Range Area Count 30250
Success at 122000 Range Area Count 30500
Success at 123000 Range Area Count 30750
Success at 124000 Range Area Count 31000
Success at 125000 Range Area Count 31250
Success at 126000 Range Area Count 31500
Success at 127000 Range Area Count 31750
Success at 128000 Range Area Count 32000
Success at 129000 Range Area Count 32250
Success at 130000 Range Area Count 32500
Success at 131000 Range Area Count 32750
Success at 132000 Range Area Count 33000
Success at 133000 Range Area Count 33250
Success at 134000 Range Area Count 33500
Success at 135000 Range Area Count 33750
Success at 136000 Range Area Count 34000
Success at 137000 Range Area Count 34250
Success at 138000 Range Area Count 34500
Success at 139000 Range Area Count 34750
Success at 140000 Range Area Count 35000
Success at 141000 Range Area Count 35250
Success at 142000 Range Area Count 35500
Success at 143000 Range Area Count 35750
Success at 144000 Range Area Count 36000
Success at 145000 Range Area Count 36250
Success at 146000 Range Area Count 36500
Success at 147000 Range Area Count 36750
Success at 148000 Range Area Count 37000
Success at 149000 Range Area Count 37250
Success at 150000 Range Area Count 37500

For Next Loop, it was taking way long, as you said increasing with every loop, inFor Each Cel in Range.

Answer 3

I want to share the result of simple tests carried out today to test limit of creating range of SpecialCells(xlCellTypeVisible). Only to keep the original post length readable, I am posting it as answer.

I filled the range A2:A150001 with 1 n number of times (each area length) with one 0 cell and filtered for 1 with code.

Sub FillRange()
Dim Arr(1 To 150000, 1 To 1), Rw As Long, xInt As Integer, AreaLen As Integer, Cnt As Integer
AreaLen = InputBox("Enter Each area Length", , 3)
Cnt = 0
    For Rw = 1 To 150000
        If Cnt > AreaLen - 1 Then
        Cnt = 0
        xInt = 0
        Else
        Cnt = Cnt + 1
        xInt = 1
        End If
    Arr(Rw, 1) = xInt
    Next
Range("A2:A150001").Value = Arr
ActiveSheet.Range("$A$1:$A$150001").AutoFilter Field:=1, Criteria1:="1"
End Sub

And then used the following code in step of 1k to creating range of SpecialCells(xlCellTypeVisible) and find where error 1004 creeps in

Sub TestSpecialCellRange()
Dim Rw As Long, Rng As Range
    For Rw = 1000 To 150000 Step 1000
    Set Rng = Nothing
    On Error Resume Next
    Set Rng = Range("A2:A" & Rw).SpecialCells(xlCellTypeVisible)
      If Err <> 0 Then
      Debug.Print "Error at " & Rw & " Error No " & Err.Number & " : " & Err.Description
      Err.Clear
      On Error GoTo 0
      Exit For
      Else
      Debug.Print "Success at " & Rw & " Range Area Count " & Rng.Areas.Count
      End If
    Next
End Sub

Following are the result of debug window

At area length 1
Success at 15000 Range Area Count 7500
Success at 16000 Range Area Count 8000
Error at 17000 Error No 1004 : Microsoft Office Excel cannot create or use the data range reference because it is too complex. Try one or more of the following:
• Use data that can be selected in one contiguous rectangle.
• Use data from the same sheet.

At area length 2
Success at 23000 Range Area Count 7667
Success at 24000 Range Area Count 8000
Error at 25000 Error No 1004 : Microsoft Office Excel cannot create or use the data range reference 

At area length 3
Success at 32000 Range Area Count 8000
Error at 33000 Error No 1004 : Microsoft Office Excel cannot create or use the data range reference because it is too complex. Try one or more of the following:

At area length 4
Success at 48000 Range Area Count 8000
Success at 49000 Range Area Count 8167
Error at 50000 Error No 1004 : Microsoft Office Excel cannot create or use the data range reference 


At area length 10
Success at 88000 Range Area Count 8000
Success at 89000 Range Area Count 8091
Success at 90000 Range Area Count 8182
Error at 91000 Error No 1004 : Microsoft Office Excel cannot create or use the data range reference 

Finally at area length 19 I succeed to cover 150 K
Success at 149000 Range Area Count 7096
Success at 150000 Range Area Count 7143

So it may be concluded that irrespective of number of rows covered, at around 8k non contagious area of the range, the error 1004 creeps in. I also tried with covering columns of the range 1 to 5 it is always same. however this is in my old good laptop with excel 2007 only, don't know what high performance machines result would be.

Edit: Next while testing iterating For each Cell in Range and adding to Union range (If condition meets) with simple code like

Set Rng = Range("A1")   ' To avoid testing "if Rng is nothing" at each row
    For Each Cel In Range("A2:A150000")
    Rw = Cel.Row
        If Cel.Value = 1 Then
        Set Rng = Union(Rng, Cel)
        End If
        If Rw Mod 1000 = 0 Then
        AreaCnt = Rng.Areas.Count
        Debug.Print " Row: " & Rw & " Range Area  Count : " & AreaCnt & " at " & Timer - tm
        DoEvents
        End If
    Next

The results shown normal behavior of union method. The time taken to process 1000 number of rows increases as the range grows heavy with non contiguous areas. Time to process 1 K cell increases to around 60 sec (at start it is 0.125 sec only) when range area count grows around 1000. Unable to achieve my target of 150 K rows with 75 K non contiguous area.

I tweak my code to utilize 30 parameter limit of Union syntax with range array. Encouraged by improvement in performance, I further tweak the code to utilize second level of union with range array with further plan to increase level to optimize performance.

Sub CellUnion3()
Dim Rw As Long, Rng(1 To 30) As Range, AreaCnt As Long, Arr(1 To 150001) As Variant
Dim Cel As Range, Rslt(1 To 30) As Range, FinalRslt As Range
Dim tm As Double, Cnt As Long, Cnt2 As Long

Set FinalRslt = Range("A1")   ' to avoid testing if Rng is nothing at each row
Cnt = 0
Cnt2 = 0
tm = Timer
SecCnt = 0

    For Each Cel In Range("A2:A150000")

        If Cel.Value = 1 Then
        Cnt = Cnt + 1
        Rw = Cel.Row

            If Cnt <= 30 Then
            Set Rng(Cnt) = Cel
            End If

            If Cnt = 30 Then
            Cnt = 0
            Cnt2 = Cnt2 + 1
            Set Rslt(Cnt2) = Union(Rng(1), Rng(2), Rng(3), Rng(4), Rng(5), Rng(6), Rng(7), Rng(8), Rng(9), Rng(10), _
            Rng(11), Rng(12), Rng(13), Rng(14), Rng(15), Rng(16), Rng(17), Rng(18), Rng(19), Rng(20), _
            Rng(21), Rng(22), Rng(23), Rng(24), Rng(25), Rng(26), Rng(27), Rng(28), Rng(29), Rng(30))
                If Cnt2 = 29 Then
                Cnt2 = 0
                On Error Resume Next
                Set FinalRslt = Union(FinalRslt, Rslt(1), Rslt(2), Rslt(3), Rslt(4), Rslt(5), Rslt(6), Rslt(7), Rslt(8), Rslt(9), Rslt(10), _
                Rslt(11), Rslt(12), Rslt(13), Rslt(14), Rslt(15), Rslt(16), Rslt(17), Rslt(18), Rslt(19), Rslt(20), _
                Rslt(21), Rslt(22), Rslt(23), Rslt(24), Rslt(25), Rslt(26), Rslt(27), Rslt(28), Rslt(29))
                    If Err <> 0 Then
                    Debug.Print " Row: " & Rw & " at " & Timer - tm & " Error: " & Err.Number & vbCrLf & Err.Description
                    Err.Clear
                    On Error GoTo 0
                    Exit For
                    Else
                    Debug.Print " Row: " & Rw & " at "; Timer - tm
                    End If
                End If
            End If
         DoEvents
         End If
    Next
AreaCnt = FinalRslt.Areas.Count
Debug.Print "Completed at " & Timer - tm & " Row: " & Rw & " Range Area Count: " & AreaCnt
End Sub

The code still lacks final touches to complete union at end (if end of range reaches between accumulating 30 range array) but ignored as it is only for test purpose

Few extracts of the debug log

With contiguous area length 1  separated by 1 row 
Row: 129920 at  289.71875 
Row: 131080 at 289.765625 Error: 1004
Method 'Union' of object '_Global' failed
Completed at 289.78125 Row: 131080 Range Area Count: 32480

With contiguous area length 3  separated by 1 row 
Row: 129920 at  307.8359375 
 Row: 131080 at 307.8984375 Error: 1004
Method 'Union' of object '_Global' failed
Completed at 307.9140625 Row: 131080 Range Area Count: 32480

With contiguous area length 5  separated by 1 row, it completed 150k Row
Row: 147204 at  236.8046875 
Row: 148248 at  242.71875 
Row: 149292 at  248.2109375 
Completed at 248.2734375 Row: 150000 Range Area Count: 24882

With the test results, is it to conclude that Microsoft union method is incapable of creating an union range with non contiguous area count more than 32 K?

Of course both the methods of creating range from SpecialCells, union and Array range can be combined and or tweaked to many simple workarounds. But the final question is

Are we really bound by 8K non contiguous area count limitation of creating range from SpecialCells and 32 K non contiguous area count limitation of union Range?