Delete row

[Lift Off]

Tried another method and couldn't get it to work. Now trying the code
below. Have a sheet with 35K rows. Need to delete rows with "x" and
leave rows with "y" in column P. (I can use "1"'s or "2"'s in column P
or whatever since I'm conditioning column P.)

Dim cell As Range
Dim Arng As Range
Dim j As Long
Set Arng = Columns("P").SpecialCells(xlConstants, xlTextValues)
For j = Arng.Count To 1 Step -1
If LCase(Arng(j).Value) = "x" _
Then Arng(j).EntireRow.Delete
Next j

I've used this code elsewhere and it worked before. Code just
runs/loops forever, or is REAL slow.

Thanks.

 

[Norman Jones]

Hi Lift Off,

Try:

'=============>>
Public Sub Tester3()
On Error Resume Next
Columns("P").SpecialCells(xlConstants, xlTextValues). _
EntireRow.Delete
On Error GoTo 0
End Sub
'<<=============

 

[Tom Ogilvy]

It is probably slow. Try this alteration

if you have a lot of formulas, set calculation to manual. Then modify the
code.

Dim cell As Range
Dim Arng As Range
Dim j As Long Dim rng as Range
Set Arng = Columns("P").SpecialCells(xlConstants, xlTextValues)
For j = Arng.Count To 1 Step -1
If LCase(Arng(j).Value) = "x" Then

if rng is nothing then
set rng = Arng(j)
else
set rng = Union(rng,Arng(j))
end if

Next j

if not rng is nothing then
rng.EntireRow.Delete
End if

 

[Norman Jones]

Hi Lift Off,

Please ignore my code, I missed the If LCase(Arng(j).Value) = "x" condition.

 

[AnExpertNovice]

End If

Range("A2").Select '<===== assumes header
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter Field:=2, Criteria1:="x" '<=== get rid of
hard code
Selection.Delete Shift:=xlUp
ExitRoutine:
On Error Resume Next
Application.ScreenUpdating = True
If booInitialFilterMode Then
ActiveSheet.ShowAllData
Else
Selection.AutoFilter
End If

ActiveSheet.UsedRange
Exit Sub
ErrorRoutine:
GoTo ExitRoutine
End Sub


To test, the following data was put into a worksheet.
a b
2 x
3
4 x
5
6 x
7
8 x
9
10 x
11
12 x
yyyy yyyy


The results after execution
a b
3
5
7
9
11
yyyy yyyy

 

[AnExpertNovice]

Hmmm, My copy and paste failed miserably, try this.



I assume you are using Application.ScreenUpdating to speed up the process.

Try this code. It has not been fully tested and is definitely not complete
code, see the lack of an error handler.

Sub DeleteRows()
On Error GoTo ErrorRoutine
Dim booInitialFilterMode As Boolean

ActiveSheet.UsedRange
Application.ScreenUpdating = False

booInitialFilterMode = ActiveSheet.FilterMode
If booInitialFilterMode Then
ActiveSheet.ShowAllData
Else
Selection.AutoFilter
End If

Range("A2").Select '<===== assumes header
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter Field:=2, Criteria1:="x" '<=== get rid of
hard code
Selection.Delete Shift:=xlUp
ExitRoutine:
On Error Resume Next
Application.ScreenUpdating = True
If booInitialFilterMode Then
ActiveSheet.ShowAllData
Else
Selection.AutoFilter
End If

ActiveSheet.UsedRange
Exit Sub
ErrorRoutine:
GoTo ExitRoutine
End Sub


To test, the following data was put into a worksheet.
a b
2 x
3
4 x
5
6 x
7
8 x
9
10 x
11
12 x
yyyy yyyy


The results after execution
a b
3
5
7
9
11
yyyy yyyy

 

[Lift Off]

No formulas in 'P', just 'x' or 'y' in every row. Calc and updating are
off.

Tom: Tried your suggestion and it wouldn't compile. Problem with the
End If statements. I tried inserting one here:

If LCase(Arng(j).Value) = "x" Then _
If rng Is Nothing Then _
Set rng = Arng(j) Else _
Set rng = Union(rng, Arng(j))
End If
End If
Next j

but I was wasn't correct.

AEN: Novice? Hardly!

Tried the second set of code. Didn't work. If I'm trying to filter
"P", where is that identified? The code sets up the filter by stops
there. No deletion of rows. Data is in every row of P.

Thanks for the quick response.

 

[Crowbar via OfficeKB.com]

Copy and paste this code exactly as it is and it will be a sub on its own

place this line

call delProws

within your macro where you would like it to perform

This scripts deletes all rows that contain the letter P within column A




Private sub delProws

Dim LastRow As Long
Dim RowNdx As Long
Dim OldVal As String

LastRow = Cells(Rows.Count, "A\").End(xlUp).Row
For RowNdx = LastRow To 1 Step -1
If Left(Cells(RowNdx, "A"), 1) = "P" Then
Rows(RowNdx).Delete
End If
Next RowNdx

end sub

 

[Tom Ogilvy]

Sub cCC()
Dim rng As Range
Dim j as Long
Set Arng = Columns("P").SpecialCells(xlConstants, xlTextValues)
For j = Arng.Count To 1 Step -1
If LCase(Arng(j).Value) = "x" Then
If rng Is Nothing Then
Set rng = Arng(j)
Else
Set rng = Union(rng, Arng(j))
End If
End If
Next j
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
End Sub

 

[AnExpertNovice]

There are two lines of hardcode that should be fixed. The first is where
I'm assuming that a header row exists that you don't want touched (Assumes
header). You might what to make the row number higher or lower depending on
your situation. Good code will test the worksheet to determine the last row
of the header.

The second lines is the Selection.Autofilter. The Criteria is assumed to be
"x" and the column is assumed to be the second column. To force it to
column P the 2 needs to be changed to 16. Again, this is hardcode that
should be eliminated. At least add them as constants in the declarations to
document their use.

Essentially, the code may work if you just change 2 to 16.

BTW, this is better than looping as long as a single column can be used to
determine the action.

One other thing. If you have a lot of formulas in your worksheet, you might
find that Filters take forever to recalculate. IF so, use this code in the
same places that ScreenUpdating was used.
Dim lngInitalCalculationMode As Long
lngInitalCalculationMode = Application.Calculation
If lngInitalCalculationMode = xlCalculationManual Then
Else
Application.Calculation = xlManual
End If

Be sure to set the CalcuationMode back to the user settings in the
ExitRoutine with this code
If lngInitalCalculationMode = xlCalculationManual Then
Application.Calculation = xlManual
Else
Application.Calculation = xlAutomatic
End If





Range("A2").Select '<===== assumes header
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter Field:=2, Criteria1:="x" '<=== get rid of
hard code

 

[AnExpertNovice]

PS. If Tom's code works I would use his instead of mine.

--
My handle should tell you enough about me. I am not an MVP, expert, guru,
etc. but I do like to help.

There are two lines of hardcode that should be fixed. The first is where
I'm assuming that a header row exists that you don't want touched (Assumes
header). You might what to make the row number higher or lower depending on
your situation. Good code will test the worksheet to determine the last row
of the header.

The second lines is the Selection.Autofilter. The Criteria is assumed to be
"x" and the column is assumed to be the second column. To force it to
column P the 2 needs to be changed to 16. Again, this is hardcode that
should be eliminated. At least add them as constants in the declarations to
document their use.

Essentially, the code may work if you just change 2 to 16.

BTW, this is better than looping as long as a single column can be used to
determine the action.

One other thing. If you have a lot of formulas in your worksheet, you might
find that Filters take forever to recalculate. IF so, use this code in the
same places that ScreenUpdating was used.
Dim lngInitalCalculationMode As Long
lngInitalCalculationMode = Application.Calculation
If lngInitalCalculationMode = xlCalculationManual Then
Else
Application.Calculation = xlManual
End If

Be sure to set the CalcuationMode back to the user settings in the
ExitRoutine with this code
If lngInitalCalculationMode = xlCalculationManual Then
Application.Calculation = xlManual
Else
Application.Calculation = xlAutomatic
End If





Range("A2").Select '<===== assumes header
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter Field:=2, Criteria1:="x" '<=== get rid of
hard code

--
My handle should tell you enough about me. I am not an MVP, expert, guru,
etc. but I do like to help.


message news:[email protected]...

 

[Lift Off]

Crowbar, I copied into procedure exactly. Put the call in where needed,
but procedure gets hung up on the line: "LastRow = Cells(Rows.Count,
"A\").End(xlUp).Row" Where/what's the "A\" represent?

Additionally, need to delete rows with 'x' in column "P". Changing
this line to:

"If Left(Cells(RowNdx, "P"), 1) = "x" Then" should do it correct?

Thanks for your help. Been working on this for days, so obviously not
a simple solution.

 

[Lift Off]

We have Lift Off!!

Tom's code worked. Thank you ALL for help with this problem. It'
been a big 'time sink' the last couple of days. Love this site!!!!

Clif

 

[Crowbar via OfficeKB.com]

The A is the column

The P is letter you are looking for to delete

Although Tom's has worked, I input a forward slash after the A. It should
have been just A as below

Any rows with the letter P in column A will be removed via this procedure


Copy and paste this code exactly as it is and it will be a sub on its own

place this line

call delProws

within your macro where you would like it to perform

This scripts deletes all rows that contain the letter P within column A

Private sub delProws

Dim LastRow As Long
Dim RowNdx As Long
Dim OldVal As String

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For RowNdx = LastRow To 1 Step -1
If Left(Cells(RowNdx, "A"), 1) = "P" Then
Rows(RowNdx).Delete
End If
Next RowNdx

end sub

 

[Dana DeLouis]

Here's a non-looping solution I use if the column doesn't have errors.
Otherwise, call one of a few alternate methods ....

Sub Demo()
'// Dana DeLouis
On Error Resume Next
With Columns("P")
.Replace "x", "#N/A", xlWhole, , , False
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
ActiveSheet.UsedRange '// Reset
End With
End Sub