Conditional Row Select and Delete

[jagstirling]

I am trying to write a Macro that will select Certain rows within a
worksheet and, depending on the character in the cell of column A,
delete or skip each selected row.

The Start cell needs to be A6, moving slowly down row by row (for
atleast 3,000 rows).

The 5 characters I have that I want to detect in Column A and then
delete their rows are ..............

Character1 = "Tel"
Character2 = "" (THIS IS A BLANK CELL IE. NO ENTRY MADE)
Character3 = "Catg"
Character4 = "-----"
Character5 = ""

I have had a stab (see below). I am getting stuck when it comes to rows
that are NOT equal to those Characters above.

*CAN ANYONE HELP ?*

Regards and thanks, J.





Dim X As Integer
Dim Y As Integer
Dim Character1 As Integer
Dim Character2 As Integer
Dim Character3 As Integer
Dim Character4 As Integer
Dim Character5 As Integer

Character1 = "Tel"
Character2 = ""
Character3 = "Catg"
Character4 = "-----"
Character5 = ""

For X = 2 To Application.WorksheetFunction.CountA(Sheets(1).Columns(1))
- 1

If Sheets(1).Cells(X, 1).Value = Character1 Then
Rows(X).Delete

If Sheets(1).Cells(X, 1).Value = Character2 Then
Rows(X).Delete

If Sheets(1).Cells(X, 1).Value = Character3 Then
Rows(X).Delete

If Sheets(1).Cells(X, 1).Value = Character4 Then
Rows(X).Delete

If Sheets(1).Cells(X, 1).Value = Character5 Then
Rows(X).Delete

If Sheets(1).Cells(X, 1).Value <> Character1 Then
Rows(X).Offset (1,0)

If Sheets(1).Cells(X, 1).Value <> Character2 Then
Rows(X).Offset (1,0)

If Sheets(1).Cells(X, 1).Value <> Character3 Then
Rows(X).Offset (1,0)

If Sheets(1).Cells(X, 1).Value <> Character4 Then
Rows(X).Offset (1,0)

If Sheets(1).Cells(X, 1).Value <> Character5 Then
Rows(X).Offset (1,0)



End Sub

 

[Dave Peterson]

One way is to loop through your characters (strings, not integers in your Dim
statements).

And a nice way to loop through them is to set them up as an array--then you can
add more strings to it without revising the guts of your code.

And it turns out it's easier to delete rows when you start from the bottom and
work your way up. then you don't have to keep track of where you are. (delete
row 234 and you're still on row 234, but it used to be 235 and it got moved
up--Starting from the bottom means you delete the row and go up--you dont' care
what happened to the stuff below!)

If you're with me so far:

Option Explicit
Sub testme02()

Dim FirstRow As Long
Dim LastRow As Long
Dim iCtr As Long
Dim iRow As Long
Dim myStrings As Variant

myStrings = Array("Tel", "", "Catg", "-----")

With Worksheets(1) ' worksheets("sheet1")???
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
For iCtr = LBound(myStrings) To UBound(myStrings)
If LCase(myStrings(iCtr)) = LCase(.Cells(iRow, "A").Value) Then
.Rows(iRow).Delete
Exit For 'already gone!
End If
Next iCtr
Next iRow
End With

End Sub

(Character5 = character2, so I only used the first.)

 

[merjet]

One problem with your code was declaring Character_ As Integer
rather than String. When deleting rows, working from bottom to top
is recommnded. Try the following.

HTH,
Merjet

Sub DeleteRows()
Dim iRow As Integer
Dim iCt1 As Integer
Dim iCt2 As Integer
Dim strArray As Variant

strArray = Array("Tel", "", "Catg", "-----", " ")
iRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
For iCt = iRow To 6 Step -1
For iCt2 = 0 To 4
Debug.Print Sheets("Sheet1").Range("A" & iCt)
If Sheets("Sheet1").Range("A" & iCt) = strArray(iCt2) Then
Sheets("Sheet1").Rows(iCt).Delete
Exit For
End If
Next iCt2
Next iCt

End Sub

 

[jagstirling]

Thanks ALOT Dave and Merjet.

J