Altered brettdj row deletion - please help

[jsabo]

Hello

Total VBA noob here, need some help. Here is the script from the KB by brettdj that deletes rows based on criteria. Can anyone please help me alter it so that it KEEPS the rows based on the criteria and deletes non-matches? I hoped "What: <>MatchString" would work but no dice. Thanks!

Sub test()

Dim MyRange As Range, DelRange As Range, C As Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim FirstAddress As String, NullCheck As String
Dim AC

'Extract active column as text
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)

SearchColumn = InputBox("Enter which column you would like to filter- press Cancel to exit", "Row Delete Code", ActiveColumn)

On Error Resume Next
Set MyRange = Columns(SearchColumn)
On Error GoTo 0

'If an invalid range is entered then exit
If MyRange Is Nothing Then Exit Sub

MatchString = InputBox("What are you filtering?", "Row Delete Code", ActiveCell.Value)
If MatchString = "" Then
NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
"Type Yes to do so, no to cancel", "Caution", "No")
If NullCheck <> "Yes" Then Exit Sub
End If

Application.ScreenUpdating = False

'to match the WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'to match a PARTIAL text string use this line
Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlPart)
'to match the case and of a WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)

If Not C Is Nothing Then
Set DelRange = C
FirstAddress = C.Address
Do
Set C = MyRange.FindNext(C)
Set DelRange = Union(DelRange, C)
Loop While FirstAddress <> C.Address
End If

'If there are valid matches then delete the rows
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

[p45cal]

try:Sub test()
Dim MyRange As Range, DelRange As Range, C As Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim FirstAddress As String, NullCheck As String
Dim AC

'Extract active column as text
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)

SearchColumn = InputBox("Enter which column you would like to filter- press Cancel to exit", "Row Delete Code", ActiveColumn)

On Error Resume Next
Set MyRange = Intersect(ActiveSheet.UsedRange, Columns(SearchColumn))
On Error GoTo 0

'If an invalid range is entered then exit
If MyRange Is Nothing Then Exit Sub

MatchString = InputBox("What are you filtering?", "Row Delete Code", ActiveCell.Value)
If MatchString = "" Then
NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
"Type Yes to do so, no to cancel", "Caution", "No")
If NullCheck <> "Yes" Then Exit Sub
End If

Application.ScreenUpdating = False


For Each cll In MyRange.Cells
If InStr(1, cll.Value, MatchString, vbTextCompare) = 0 Then
If DelRange Is Nothing Then Set DelRange = cll Else Set DelRange = Union(DelRange, cll)
End If
Next cll
'If there are valid matches then delete the rows
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

[jsabo]

Thanks for the response. Tried it, didnt work. Error: "Compile Error, Variable Not Defined."

It highlighted "cll" in this line: For Each cll In MyRange.Cells

thoughts? thanks in advance

EDIT: is it supposed to be "cell"? trying now... D'oh, didnt work

EDIT2: Added this @ the top: Dim Cll As Excel.Range and now it works. Thanks for your help! now to stop it from deleting the 1st row...

[JKwan]

Try removing
Option Explicit
from the top of the module page

[p45cal]

Try removing
Option Explicit
from the top of the module page
…or alter:
Dim AC
to
Dim AC, cll