Delete Entire Row.

S

Sam

Hi ...

We only want to mail advertising to individuals, not businesses. Here is
a short macro I wrote to eliminate obvious businesses from the list:

Sub Eliminate()
Dim I As Long
Dim FullName As String

For I = 2 To 500
FullName = Worksheets(1).Cells(I, 4).Value
If InStr(2, FullName, " COMPANY", 1) > 0 Then
Worksheets(1).Cells(I, 1).Select
Selection.EntireRow.Delete
End If
Next I
End Sub

It worked ... Kind of. When it came to a record with `Company' in the
name it deleted it. However, if the next record also had `Company' in the
name, it was not deleted. I guess that when it eliminated record seven,
record eight became record seven, and it was done with seven. It went on to
eight, which was nine until a second ago.

I fixed it, though. I added one line:

Sub Eliminate()
Dim I As Long
Dim FullName As String

For I = 2 To 500
FullName = Worksheets(1).Cells(I, 4).Value
If InStr(2, FullName, " COMPANY", 1) > 0 Then
Worksheets(1).Cells(I, 1).Select
Selection.EntireRow.Delete
I = I - 1
End If
Next I
End Sub

Now I is not incremented - Program checks record seven again. Works fine.
but there are two things I don't like.

1) Instead of `For I = 2 To 500,' I would the loop to just automatically run
until every record is checked:
`For I = 2 To EndOfColumn.'
There must be way to do that, but I don't know what it is.

2) I don't like screwing with I. I'm just an amateur, but I bet `real'
programmers never alter the value of a loop counter inside the loop itself.
(Do they??)

Sam
--
A man who had lately declared
That property ought to be shared,
Thought it going too far
When they called for his car,
And a list of exceptions prepared.

Thomas Thorneley,
From The Penguin
Book Of Limericks
 
B

Bob Phillips

Sam,

When deleting rows it is better to one of two things
- delete from the bottom up
- build up a range of rows to delete and delete them all at the end

Here is your code modified for the first, with automatic detection of the
end

Sub Eliminate()
Dim I As Long
Dim FullName As String
Dim oWS AsWorksheet

Set oWS = Worksheets(1)
For I = Cells(Rows.Count,"A").End(xlUp).Row To 2 Step -1
FullName = oWS.Cells(I, 4).Value
If InStr(2, FullName, " COMPANY", 1) > 0 Then
oWS.Cells(I, 1).EntireRow.Delete
End If
Next I

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
G

Gord Dibben

Sam

Try this one.

Notice it finds the last row in the column you choose then
deletes from the bottom up(For i = iLastrow To 1 Step -1)

Option Compare Text
Sub Delete_By_Criteria()
Dim i As Integer
Dim iLastrow As Integer
Dim Collet As String
Set Wks = ActiveSheet
Application.ScreenUpdating = False
Collet = InputBox("Enter Your Column Letter")
whatwant = InputBox("Choose Criteria" & Chr(13) _
& "Wildcards such as *PY* can be used")
iLastrow = Wks.Cells(Rows.Count, Collet).End(xlUp).Row
For i = iLastrow To 1 Step -1
If Wks.Cells(i, Collet).Value Like whatwant Then
Wks.Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub

Gord Dibben Excel MVP
 
R

Rob van Gelder

Best to work from bottom to up so you don't have to deal with these types of
issues.

If you must go from top to bottom, then this code should work:

Sub Eliminate()
Const cFullName = 4
Dim i As Long, j As Long

With Worksheets(1)
i = 2: j = .Cells(.Rows.Count, cFullName).End(xlUp).Row
Do Until i > j
If InStr(1, .Cells(i, cFullName).Value, " COMPANY",
vbTextCompare) <> 0 Then
.Rows(i).EntireRow.Delete
j = j - 1
Else
i = i + 1
End If
Loop
End With
End Sub
 
J

J.E. McGimpsey

Even better (at least in terms of speed) is eliminating all the
incremental deletions and deleting all the rows at once:

Public Sub Eliminate()
Const cFullName = 4
Dim rCell As Range
Dim rDelete As Range
With Worksheets(1)
For Each rCell In .Range(.Cells(1, cFullName), _
.Cells(.Rows.Count, cFullName).End(xlUp))
With rCell
If Instr(.Text, " COMPANY", vbTextCompare) <> 0 Then
If rDelete Is Nothing Then
Set rDelete = .Cells
Else
Set rDelete = Union(rDelete, .Cells)
End If
End If
End With
Next rCell
End With
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

or, if " COMPANY" is expected to occur rarely, do a .Find() loop.
 
R

Rob van Gelder

An excellent point worth noting.

My advise was more to demonstrate alternate looping, which the poster seemed
to struggle with.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top