4
\$\begingroup\$

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.

\$\endgroup\$
3
  • \$\begingroup\$ There are a variety of resources to review limitations of the 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 updated ProperUnion function that addresses many of the limitations. \$\endgroup\$ Commented Jul 25, 2019 at 20:54
  • \$\begingroup\$ This Excel reference page implies that the 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\$ Commented Jul 25, 2019 at 20:56
  • \$\begingroup\$ @PeterT, Many Thanks for going through the tiring question and prompt response. I wll go through all the links and come back. \$\endgroup\$ Commented Jul 25, 2019 at 23:39

3 Answers 3

Reset to default
4
\$\begingroup\$

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.

enter image description here

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
\$\endgroup\$
6
  • \$\begingroup\$ First of all, Thanks for your valuable time spend on the post. I will go through it in details and come back. However at a glance, congratulate for brilliant maximum utilization of 32 argument property of Union rage into a class. +1 for that before going in details and please mention excel version used for readers . I will try it in 2007. \$\endgroup\$ Commented Aug 17, 2019 at 6:37
  • \$\begingroup\$ @AhmedAU Are you running 32 or 64 bit Office? \$\endgroup\$ Commented Aug 17, 2019 at 10:35
  • \$\begingroup\$ may treat me as Old School, still with 32 bit. Still not find time to test or study in details, may be delayed longer. Please bear .with me. \$\endgroup\$ Commented Aug 17, 2019 at 12:01
  • \$\begingroup\$ the codes are like poetry and running them is like music from violin. I also created another class combining FastUnoin with UnionCollenction. After number of testing with varying conditions observed that in general Brute force Looping, Combined Fast loop_Collection method and Union_Collection method taking more or less same time (19s for 30K) for high Area counts.But final conclusion and salute to you, with ** UnionCollenction reducing CellCountGoal to 100 brought down ProcTime to 4.3 from 19 is the best performer in this context. ** \$\endgroup\$ Commented Aug 18, 2019 at 5:55
  • \$\begingroup\$ Another point the Combined Fast loop_Collection method gives best time of 0.18 (18.2 is formatting time only. for 30K with CellCountGoal of 100) for Creating range collection. This deemed fit for other application where creation of union range is absolute necessary. Finally again I have no word to thank you for wasting your valuable time on such boring topic. \$\endgroup\$ Commented Aug 18, 2019 at 5:58
1
\$\begingroup\$

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.

enter image description here

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.

\$\endgroup\$
1
  • \$\begingroup\$ Thanks for taking interest. The SpecialCells limit is fixed in 2010. Could you please feedback about 32K limit of Union Range. \$\endgroup\$ Commented Aug 5, 2019 at 0:27
0
\$\begingroup\$

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?

\$\endgroup\$

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.