Delete Rows
Sub Delete_Rows()
Application.ScreenUpdating = False
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim rng As Range
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1
With ActiveSheet
Set rng = Range("K" & Firstrow).Resize(Lastrow - Firstrow + 1)
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
With Application
.Calculation = CalcMode
End With
ActiveWindow.View = ViewMode
End Sub
--
__________________________________
HTH
Bob
"JohnUK" wrote in message
...
Hi, I have a worksheet that is constantly changing in range size and need
a
piece of code that can delete all rows below the last row containing data
in
column K bar 10. I say column k because there are formulas that run down
other columns and column K has just values.
I have been using:
Sub Delete_Rows()
Application.ScreenUpdating = False
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.count + Firstrow - 1
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1
If IsError(.Cells(Lrow, "A").Value) Then
ElseIf .Cells(Lrow, "F").Value = "row" Then .Rows(Lrow).Delete
End If
Next
End With
End Sub
But proves to be too slow especially when I have to wait for up to a 1000
lines to be deleted
Help greatly appreciated
John
|