delete all rows not beginning with

  • Thread starter Thread starter SITCFanTN
  • Start date Start date
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,
 
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
 
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
 
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.
 
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!
 
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" έγγÏαψε:
 
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" έγγÏαψε:
 
Back
Top