Can anyone help me convert to more efficient code?

I borrowed this sub from a site I ran across but it takes about 25-30
seconds on a P4. I know there is a better way, but I don't have the
brain to code. I would appreciate very much an offer for any
improvements.

I am trying to remove all rows where the F column has no value.

Thank you all.
Dan

Sub DeleteEmptyRowsWhereFIsEmpty()
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
.ScreenUpdating = False
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, "F").Value) Then
'Do nothing, This'll avoid a error if there is a error
in the cell

ElseIf .Cells(Lrow, "F").Value = "" Then .Rows(Lrow).Delete
'This will delete each row with the blan value in
Column F, case sensitive.

End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

So you are just wanting to delete any row with a blank value in column F? If
so then try this code...

Sub DeleteBlanks()
Dim rngBlanks As Range

On Error Resume Next
Set rngBlanks = Columns("F").SpecialCells(xlBlanks)
On Error GoTo 0
If rngBlanks Is Nothing Then
MsgBox "Sorry... Nothing to delete."
Else
rngBlanks.EntireRow.Delete
End If
End Sub

Your code is slow because it is deleting one row at a time. This deletes all
of the blank rows at once which should be faster...
--
HTH...

Jim Thomlinson


"slo" wrote:

> I borrowed this sub from a site I ran across but it takes about 25-30
> seconds on a P4. I know there is a better way, but I don't have the
> brain to code. I would appreciate very much an offer for any
> improvements.
>
> I am trying to remove all rows where the F column has no value.
>
> Thank you all.
> Dan
>
> Sub DeleteEmptyRowsWhereFIsEmpty()
> 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
> .ScreenUpdating = False
> 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, "F").Value) Then
> 'Do nothing, This'll avoid a error if there is a error
> in the cell
>
> ElseIf .Cells(Lrow, "F").Value = "" Then .Rows(Lrow).Delete
> 'This will delete each row with the blan value in
> Column F, case sensitive.
>
> End If
> Next
> End With
>
> ActiveWindow.View = ViewMode
> With Application
> .ScreenUpdating = True
> .Calculation = CalcMode
> End With
>
> End Sub
>
>

That did it! Thanks a ton! Hope you win the lotto or something like
that.
Dan

Jim Thomlinson wrote:
> So you are just wanting to delete any row with a blank value in column F? If
> so then try this code...
>
> Sub DeleteBlanks()
> Dim rngBlanks As Range
>
> On Error Resume Next
> Set rngBlanks = Columns("F").SpecialCells(xlBlanks)
> On Error GoTo 0
> If rngBlanks Is Nothing Then
> MsgBox "Sorry... Nothing to delete."
> Else
> rngBlanks.EntireRow.Delete
> End If
> End Sub
>
> Your code is slow because it is deleting one row at a time. This deletes all
> of the blank rows at once which should be faster...
> --
> HTH...
>
> Jim Thomlinson
>
>
> "slo" wrote:
>
> > I borrowed this sub from a site I ran across but it takes about 25-30
> > seconds on a P4. I know there is a better way, but I don't have the
> > brain to code. I would appreciate very much an offer for any
> > improvements.
> >
> > I am trying to remove all rows where the F column has no value.
> >
> > Thank you all.
> > Dan
> >
> > Sub DeleteEmptyRowsWhereFIsEmpty()
> > 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
> > .ScreenUpdating = False
> > 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, "F").Value) Then
> > 'Do nothing, This'll avoid a error if there is a error
> > in the cell
> >
> > ElseIf .Cells(Lrow, "F").Value = "" Then .Rows(Lrow).Delete
> > 'This will delete each row with the blan value in
> > Column F, case sensitive.
> >
> > End If
> > Next
> > End With
> >
> > ActiveWindow.View = ViewMode
> > With Application
> > .ScreenUpdating = True
> > .Calculation = CalcMode
> > End With
> >
> > End Sub
> >
> >