rows delete via macro needs too much time

Hello all,
I wrote a macro which have to delete some rows in a sheet.
The sheet contains many sum formulas. When I start the
macro, it work very well but after 10 deletes it needs
more time than before and after 20 deletes it needs over
30 seconds for one delete. When I break the macro and do
the delete manually, the same happen.

Post the code. Also, have you tried turning off screenupdating and calculation
whilst it is running, and then putting it back on at the end:-

Sub xyz()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Code................

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub



Various examples of code to delete rows:-

Sub DlBlnks()

On Error Resume Next ' In case there are no blanks
Columns("A:A").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange for Excel 97

'more information in
'Delete Cells/Rows in Range, based on empty cells, or cells with specific values
'http://www.mvps.org/dmcritchie/excel/delempty.htm
End Sub

-----------------------------------------------------

Public Sub DeleteReallyBlankRows()
'Chip Pearson
'Will delete all rows that are entirely blank
Dim r As Long
Dim c As Range
Dim n As Long
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
n = 0
For r = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(r).E ntireRow) = 0 Then
Rng.Rows(r).EntireRow.Delete
n = n + 1
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

-----------------------------------------------------

Sub DeleteEmptyRows()
'John Walkenbach
'Will delete all rows that are entirely blank
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub

-----------------------------------------------------

Sub DeleteEmptyRows2()
'John Walkenbach Edited
'Will delete all rows where E:AI is entirely blank
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Cells(r, 5).Resize(1, 31)) = 0 Then Rows(r).Delete
Next r
End Sub

-----------------------------------------------------

Public Sub DeleteBlankRows():
'This will delete all the blank rows if cell in Col A is blank within the active
sheet.

On Error Resume Next
Intersect(ActiveSheet.UsedRange.EntireRow, Columns(1)).SpecialCells( _
xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
Public Sub DeleteSelectionBlanks():
'This will delete all the blank rows contained within a selection of blank rows.
'Select by dragging down on the row handles to select entire range containing
rows
'you wish to delete.

On Error Resume Next
Intersect(Selection.EntireRow, Columns(1)).SpecialCells( _
xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub

-----------------------------------------------------

Sub DelRows1()

ans = InputBox("What string do you want rows to be deleted if they contain it?")
Application.ScreenUpdating = False

LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count

Set Rng = Range(Cells(1, "A"), Cells(LastRow, "A"))

With Rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:=ans
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Application.ScreenUpdating = True

End Sub

-----------------------------------------------------

Sub Delete_Rows()

Dim RowNdx As Long
Dim LastRow As Long

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For RowNdx = LastRow To 1 Step -1
If InStr(UCase(Cells(RowNdx, "A").Value), "OLD") Then
Rows(RowNdx).Delete
End If
Next RowNdx

-----------------------------------------------------

End Sub
Sub DelBlankLookingCells1()
'Note:- Cells not rows
Dim Rng As Range
Dim cel As Range
Dim DelRng As Range
Set DelRng = Nothing
Set Rng = ActiveSheet.UsedRange

For Each cel In Rng
If Len(Trim(cel.Value)) = 0 Then
If DelRng Is Nothing Then
Set DelRng = cel
Else
Set DelRng = Union(DelRng, cel)
End If
End If
Next
If Not DelRng Is Nothing Then
DelRng.Delete Shift:=xlToLeft
End If
End Sub

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission :-)
----------------------------------------------------------------------------



"PZ" wrote in message
...
Hello all,
I wrote a macro which have to delete some rows in a sheet.
The sheet contains many sum formulas. When I start the
macro, it work very well but after 10 deletes it needs
more time than before and after 20 deletes it needs over
30 seconds for one delete. When I break the macro and do
the delete manually, the same happen.


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.708 / Virus Database: 464 - Release Date: 18/06/2004

Also note that none of these do any selecting, which if you have recorded and
edited code, you may well find that yours do. This will slow done any routine
significantly, and should be avoided if possible.

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission :-)
----------------------------------------------------------------------------


Snip


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.708 / Virus Database: 464 - Release Date: 18/06/2004