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).EntireRow.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).EntireRow) = 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
