delete all rows not beginning with

S

SITCFanTN

I need to write some code that would delete all rows in the open document
where AAAF800 or AAAF900 or AAA1000 are not in column A. I have searched the
site and am not able to find anything that would help me with this. Any
suggestions are greatly appreciated. Thank you,
 
J

JLGWhiz

You can try this. It assumes row 1 as header row.

Sub deleRwCpy()
Dim myRng As Range, sh As Worksheet
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
If sh.Cells(i, 1) <> "AAAF800" And sh.Cells(i, 1) <> _
"AAAF9000" And sh.Cells(i, 1) <> AAA1000 Then
Cells(i, 1).EntireRow.Delete
End If
Next
End Sub
 
L

Lars-Åke Aspelin

I need to write some code that would delete all rows in the open document
where AAAF800 or AAAF900 or AAA1000 are not in column A. I have searched the
site and am not able to find anything that would help me with this. Any
suggestions are greatly appreciated. Thank you,
Click to expand...


Try this macro:

Sub delete_rows()
For r = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Not (Cells(r, "A") = "AAAF800" Or _
Cells(r, "A") = "AAAF900" Or _
Cells(r, "A") = "AAA1000") Then
Rows(r).Delete
End If
Next r
End Sub

Hope this helps / Lars-Åke
 
B

B Lynn B

You don't really need code to accomplish this. Just apply a filter to the
range, and use the column A filter dropdown selector to uncheck those three
items. Then delete the remaining rows.
 
G

Gary''s Student

Here is one approach:

Sub RowKiller()
Dim r As Range, rKill As Range
Set r = Intersect(ActiveSheet.UsedRange, Range("A:A"))
Set rKill = Nothing
For Each rr In r
v = rr.Value
If v = "AAAF800" Or v = "AAAF900" Or v = "AAAF1000" Then
Else
If rKill Is Nothing Then
Set rKill = rr
Else
Set rKill = Union(rKill, rr)
End If
End If
Next
If rKill Is Nothing Then
Else
rKill.EntireRow.Delete
End If
End Sub

We build a set of rows and delete them in one swell foop!
 
J

John_John

Another diferent approach:

Sub DeleteRows()
Dim i As Integer
Dim rngFound As Range
Dim rngAllRows As Range

On Error Resume Next
Set rngAllRows = Range("A:A")
For i = 800 To 1000 Step 100
Set rngFound = Range("A:A").Find("AAAF" & i)
If Not rngFound Is Nothing Then
Set rngAllRows = rngAllRows.ColumnDifferences(rngFound)
End If
Set rngFound = Nothing
Next i
rngAllRows.EntireRow.Delete
End Sub

Ο χÏήστης "Lars-Ã…ke Aspelin" έγγÏαψε:
 
J

John_John

Oh! Sorry! It was great my carelessness !
Thnks Lars!
I will try to make amends.

Sub DeleteRows()
Dim i As Integer
Dim rngFound As Range
Dim rngAllRows As Range
Dim astrText() As Variant

On Error Resume Next
astrText = Array("AAAF800", "AAAF900", "AAA1000")
Set rngAllRows = Range("A:A")
For i = LBound(astrText) To UBound(astrText)
Set rngFound = Range("A:A").Find(astrText(i))
If Not rngFound Is Nothing Then
Set rngAllRows = rngAllRows.ColumnDifferences(rngFound)
End If
Set rngFound = Nothing
Next i
rngAllRows.EntireRow.Delete
End Sub




Ο χÏήστης "Lars-Ã…ke Aspelin" έγγÏαψε:
 
Top