Delete Rows that do not contain

[SITCFanTN]

I want to create a macro that will run through 10,000 plus rows and quickly
delete all rows if Col A does not contain the text of T75TA. Any help you
can provide is greatly appreciated, thank you.

 

[Paul C]

This should do the trick

Sub DeleteRows()

Dim findstring As String

lastrow = Range("A15000").End(xlUp).Row
findstring = "T75TA"
For A = lastrow To 1 Step -1
If InStr(CStr(Cells(A, 1)), findstring) < 1 Then Cells(A,
1).EntireRow.Delete
Next A

End Sub

 

[Mike]

this will work

Option Explicit
Sub Remove_Unwanted_Rows()
'this deletes all rows with cells exactly matching cases
Dim rng As Range
Dim cell, RowArray As Range
Set rng = ActiveSheet.Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
For Each cell In rng
Select Case cell
Case Is = "T75TA"
If RowArray Is Nothing Then
Set RowArray = cell.EntireRow
Else
Set RowArray = Union(RowArray, cell.EntireRow)
End If
End Select
Next cell
On Error Resume Next
RowArray.Delete
Err.Clear
End Sub

I want to create a macro that will run through 10,000 plus rows and quickly
delete all rows if Col A does not contain the text of T75TA. Any help you

this > can provide is greatly appreciated, thank you.

 

[Jarek Kujawa]

Sub cus()

For i = 10000 To 1 Step -1
If Len(Cells(i, 1)) And InStr(1, "T75TA", Cells(i, 1)) Then Cells
(i, 1).Rows.EntireRow.Delete
Next i

End Sub

 

[Rick Rothstein]

Give this macro a try, just set the 3 constant (Const) statements at the
beginning to match your actual set up...

Sub RemoveNotCurrentRecords()
Dim X As Long
Dim LastRow As Long
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range

Const DataStartRow As Long = 2
Const TestColumn As String = "A"
Const SheetName As String = "Sheet1"

On Error GoTo Whoops
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For X = LastRow To DataStartRow Step -1
' <<Set your test condition here>>
If UCase(.Cells(X, TestColumn).Value) = "T75TA" Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(X, TestColumn)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(X, TestColumn))
End If
If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete xlShiftUp
Set RowsToDelete = Nothing
End If
End If
Next
End With
If Not RowsToDelete Is Nothing Then
RowsToDelete.EntireRow.Delete xlShiftUp
End If

Whoops:
Application.Calculation = OriginalCalculationMode
Application.ScreenUpdating = True
End Sub

 

[SITCFanTN]

I only want to keep the rows with T75TA, all the others I need to delete. I
could not get this to work...am I doing something wrong? Thank you.

 

[Rick Rothstein]

I think I have my test backwards. Change this line...

If UCase(.Cells(X, TestColumn).Value) = "T75TA" Then

to this..

If UCase(.Cells(X, TestColumn).Value) <> "T75TA" Then

 

[Jarek Kujawa]

mu fault, misread your post

this should be better

Sub cus()
For i = 20 To 1 Step -1
Cells(i, 1).Activate
If Len(Cells(i, 1)) And InStr(1, "T75TA", Cells(i, 1)) = 0 Then
Cells(i, 1).Rows.EntireRow.Delete
Next i
End Sub