delete rows

  • Thread starter Thread starter Jack Sons
  • Start date Start date
J

Jack Sons

Hi all,

I have some 500 rows. I want to delete all rows, except row 1, of which col
G is zero or blank while col A shows anything else than a string of which
the first character is S or P.

In other words, I want to keep row 1 and all rows in which col A shows text
starting with S or P and all rows not having zero or blank in col G.

I need the fastest code possible, my do loop takes a lot of time. I thank
you in advance for your assistance.

Jack Sons
The Netherlands
 
Have you already turned off screen updates and auto calculation? Those are
typically the real time hogs. In general, if none of the work inside the
loop depends on changes made by the loop:
application.calculation=xlmanual
application.screenupdating=false
.... do the work here ...
application.screenupdating=true
application.calculation=xlautomatic
 
Hi Jack,

Try:
'==============>>
Public Sub Tester001()
Dim rng As Range
Dim rCell As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim delRng As Range
Dim blDelete As Boolean
Dim CalcMode As Long

Set WB = ActiveWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet3") '<<===== CHANGE

Set rng = SH.Range("A2").Resize(SH.UsedRange.Rows.Count - 1)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
blDelete = False
With rCell
If rCell.Offset(0, 6).Value = 0 Then
blDelete = True

ElseIf LCase(Left(.Value, 1)) <> "s" _
And LCase(Left(.Value, 1)) <> "p" Then
blDelete = True
Else
blDelete = False
End If

If blDelete Then
If delRng Is Nothing Then
Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
End If
End With
Next rCell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<==============
 
Norman,

Thanks for the code. Looks much more intelligent than mine and it is super
fast, but ... it deletes everything except row 1.

I made a few changes (see below) but to no avail. Can you help me out of
this impasse?

Jack.

'==============>>
Public Sub Tester001()
Dim rng As Range
Dim rCell As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim delRng As Range
Dim blDelete As Boolean
Dim CalcMode As Long

' Set WB = Workbooks("LEERL05") 'ActiveWorkbook '<<===== CHANGE
' Set SH = Workbooks("LEERL05").Sheets("achterstanden") '<<=====
CHANGE

'Set rng =
Workbooks("LEERL05").Sheets("achterstanden").Range("A2").Resize(Workbooks("LEERL05").Sheets("achterstanden").UsedRange.Rows.Count
- 1)
Set rng = Range("A2").Resize(UsedRange.Rows.Count - 1)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
blDelete = False
With rCell
If rCell.Offset(0, 6).Value = 0 Or rCell.Offset(0, 6).Value = ""
Then
blDelete = True

ElseIf LCase(Left(.Value, 1)) <> "S" _
And LCase(Left(.Value, 1)) <> "P" Then
blDelete = True
Else
blDelete = False
End If

If blDelete Then
If delRng Is Nothing Then
Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
End If
End With
Next rCell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<==============
 
Hi Jack,

I think that your problem relates to the changes you have effected.

You changed:
to:

If rCell.Offset(0, 6).Value = 0 Or rCell.Offset(0, 6).Value = ""
Click to expand...

The addition of the Or condition is unnecessary: an empty cell has a zero
value.

You changed:
to:

ElseIf LCase(Left(.Value, 1)) <> "S" _
And LCase(Left(.Value, 1)) <> "P" Then
Click to expand...

This change will cause all rows (except for row 1) to be deleted because a
lower case anything can never equate to an upper case S or an upper case P -
or, indeed an upper case anything.

Try, therefore this version of my original code, which is amended only to
insert your workbook and worksheet names.

'==============>>
Public Sub Tester002()
Dim rng As Range
Dim rCell As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim delRng As Range
Dim blDelete As Boolean
Dim CalcMode As Long

Set WB = Workbooks("LEERL05.xls")
Set SH = WB.Sheets("achterstanden")

Set rng = SH.Range("A2").Resize(SH.UsedRange.Rows.Count - 1)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
blDelete = False
With rCell
If rCell.Offset(0, 6).Value = 0 Then
blDelete = True

ElseIf LCase(Left(.Value, 1)) <> "s" _
And LCase(Left(.Value, 1)) <> "p" Then
blDelete = True
Else
blDelete = False
End If

If blDelete Then
If delRng Is Nothing Then
Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
End If
End With
Next rCell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<==============

Running this code on my test data, the code ran without problem and deleted
only rows which were both unpopulated in column G and did not have an
initial S or P character in column A. As written, the S and P characters
could be upper or lower case.
 
Back
Top