Solved: range areas limit in 2003

[ntrauger]

The maximum number of areas a range object can hold in 2003 appears to be 400. Can anyone confirm or deny this? Also, is there a difference in 2007? Did some Googling and did not see this explicitly in any forums nor on the MSDN site. Thanks!

[mikerickson]

In Excel 2004, this code runs as written, but fails if the upper limit is 257.
Dim myRange As Range, i As Long
Set myRange = Range("A1")
For i = 2 To 256
Set myRange = Union(myRange, Cells(i, i))
Next i
MsgBox myRange.Areas.Count

So it would seem that 256 is the limit in Excel 2004.

In Excel 2011, the limit was greater than 2,000.

[ntrauger]

Well, the max column index in 2003 is also 256.

Excel will freeze when it reaches the maximum. Running a simple test like you did and printing the areas count to the immediate window, I was able to get it to 1173 individual 1-cell areas or 1221 2-cell areas before it froze. I'm guessing my original estimate was much less because I based it off of the data I was working with at the time.

Perhaps it's limited to the available system resources?

[mikerickson]

Good catch on the column count. I modified the test program to


Set myRange = Union(myRange, Cells(i, (i Mod 10) + 1))

and got it to run properly at 2570 areas.

I also would guess that it is system resources that determine the maximum number of areas.

[ntrauger]

Alright, so the next question is how do I test for when system resources are about to be maxed out? It appears to be unpredictable and it's not catchable since it freezes Excel. I'm guessing it would require API, which is beyond me. Right now I'm breaking the routine into batches that limit the number of areas to 400, but that's a compromise and not guaranteed to work on every machine.

[mikerickson]

If a range needs that many Areas, I suspect that the spreadsheet is horribly laid out. I would consider a redesign of the worksheets before trying to accommodate that discontinuous a range.

[ntrauger]

Point taken. :) The goal is to speed up the process of deleting multiple (about 20,000 right now, but subject to change) duplicate rows. The filter method takes twice as long as what I've got now. Deleting the rows one at a time takes forever.

[ntrauger]

Marking this as solved because the original question has been answered. But if anyone has a better method than this for removing a mega mess of duplicates, let me know.Private Sub CommandButton1_Click()
Dim r
Dim c As Range
Dim flag As Boolean
Dim x As Long, y As Long, z As Long, a As Long
On Error Resume Next
ChDir ("C:\ForestPro")

On Error GoTo catchAll
r = Application.GetOpenFilename(, , "Open ForestPro Database")
If r = False Then Exit Sub

flag = Application.DisplayStatusBar
Application.DisplayStatusBar = True

Application.StatusBar = "Processing step 1 of 5: Preparing workspace..."
Sheet1.UsedRange.Columns.Delete (xlToLeft)

On Error GoTo overload
Application.StatusBar = "Processing step 2 of 5: Retrieving data from """ & r & """ ..."
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & r & ";Mode=Share Deny " _
, _
"Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:En" _
, _
"gine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB" _
, _
":New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on" _
, _
" Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Tally")
.Name = r & "_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = r
.Refresh BackgroundQuery:=False
End With

On Error GoTo catchAll
Application.StatusBar = "Processing step 3 of 5: Filtering..."
Columns("A:J").Delete Shift:=xlToLeft
Columns("B:H").Delete Shift:=xlToLeft
Columns("D:L").Delete Shift:=xlToLeft
Columns("A:C").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

Application.ScreenUpdating = False
x = 2: y = 3
Do
If Cells(y, 1) = vbNullString Then Exit Do
a = Cells(1, 1).End(xlDown).Row
If Cells(y, 1) = Cells(x, 1) Then
If c Is Nothing Then
Set c = Range(Cells(y, 1), Cells(y, 3))
Else
Set c = Union(c, Range(Cells(y, 1), Cells(y, 3)))
End If
If c.Areas.Count = 400 Then '< ! seems to be a safe level. Is limited by system resources.
Application.StatusBar = "Processing step 3 of 5: Filtering: " & CInt(y / a * 100) & "% (Recycling memory...)"
'Clear c. We're done with those cells.
c.Delete xlShiftUp
a = a - Cells(1, 1).End(xlDown).Row
'Reposition examination point
x = x - a + 1
y = x
Set c = Nothing
a = Cells(1, 1).End(xlDown).Row
End If
y = y + 1
Else
x = y
y = y + 1
End If
Application.StatusBar = "Processing step 3 of 5: Filtering: " & CInt(y / a * 100) & "%"
Loop

Application.StatusBar = "Processing step 3 of 5: Filtering..."
If Not c Is Nothing Then c.Delete xlShiftUp
Columns("C").NumberFormat = "m/d/yyyy"

On Error Resume Next
For Each c In Range("C1:C" & Cells(1, 3).End(xlDown).Row)
Application.StatusBar = "Processing step 4 of 5: Forcing text to date: row " & c.Row
c = CDate(c)
Next

On Error GoTo catchAll
Application.ScreenUpdating = True

Application.StatusBar = "Processing step 5 of 5: Creating pivot table..."
With ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
Range("A1:C" & Cells(1, 1).End(xlDown).Row)).CreatePivotTable(TableDestination:=Cells(3, 5), _
TableName:="PivotTable" & ThisWorkbook.PivotCaches.Count + 1, DefaultVersion:=xlPivotTableVersion10)
.AddFields RowFields:="CRUISER ID", ColumnFields:="DATE"
.AddDataField .PivotFields("PLOT"), "Count of PLOT", xlCount
End With

Application.StatusBar = "Done!"
Application.StatusBar = False
Application.DisplayStatusBar = flag

Exit Sub
catchAll:
MsgBox "Error #" & Err.Number & vbNewLine & "Unhandled exception." & vbNewLine & "If problem persists, contact Nate Trauger.", vbCritical, "Procedure failed and aborted"
GoTo allErr

overload:
MsgBox "Error #" & Err.Number & vbNewLine & "Data set may be too large for this version of Excel." & vbNewLine & "Check that the record count does not exceed " & Rows.Count & "." & vbNewLine & "If problem persists, contact Nate Trauger.", vbCritical, "Procedure failed and aborted"
allErr:
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = flag
End Sub