Hi Michael,
Replace that code with:
'=============
Public Sub Tester2()
Dim rng1 As Range, rng2 As Range
Dim CalcMode As Long
Set rng1 = Range("A1:D4000") '<<==== CHANGE
With Application
.ScreenUpdating = False
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
On Error Resume Next
Set rng2 = rng1.Columns(1).SpecialCells _
(xlCellTypeVisible)
Intersect(rng2.EntireRow, rng1.EntireColumn).ClearContents
On Error GoTo 0
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
'<<=============
--
---
Regards,
Norman
"Norman Jones" wrote in message
...
Hi Michael,
As far as the suggested SpecialCells method is concerned, a critical
poinr might be reached with 8192+ non-contiguous areas, which would
coorespond with a minimum of 16384 (= 8192*2) cells. - see the Microsoft
KnowlegeBase Article # 83229:
http://support.microsoft.com/kb/832293/en-us
Given your range, this should not present a problem.
However, the suggested code could be made more efficient by resticting the
area of interest to the first column of your range, i.e.:
'=============
Public Sub Tester2()
Dim CalcMode As Long
With Application
.ScreenUpdating = False
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
On Error Resume Next
Range("A1:D4000").Columns(1).SpecialCells _
(xlCellTypeVisible).EntireRow.ClearContents
On Error GoTo 0
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
'<<=============
Note that to enhance speed, the suggested code turns off, and later
restores, screen refreshing and automatic calculation.
---
Regards,
Norman
"michael.beckinsale" wrote in message
ups.com...
Norman,
Thanks. I have approx 4000 cells in the range so l will go with
Cells.special method