Solved: Delete Row based on Column Criteria (with looping)

[snipun]

In this post, we were given a way to search for string in a specified column and to delete the rows based on string criteria (whole/partial/case&whole).

vbaexpress.com/kb/getarticle.php?kb_id=260#instr

I'm curious how I'd build a loop in that would allow you to search for string after string until the user hit CANCEL.
e.g., I want to search for clinic names (using partial search), but I need to delete clinics that contain part of the string:
-X
Emergency
XRAY

How/where would I do that?
Thanks in advance

[snipun]

This is what I have now (almost the same as the originally linked code)

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 Search Column - press Cancel to exit sub", "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("Enter Search string", "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, else code will exit", "Caution", "No")
If NullCheck <> "Yes" Then Exit Sub
End If

Application.ScreenUpdating = False

Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlPart)
'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

[mdmackillop]

Welcome to VBAX
Can you post a workbook with sample data? Use Manage Attachments in the Go Advanced reply section

[snipun]

I saved an xlsx without the macro already in it. Is this ok or do you want the macro included? I know how people are leary of macros being transmitted.

p.s. I'll be in your neck of the woods for my honeymoon in the near future :)

Thanks

[mdmackillop]

Give this a try. I've split the macro to more manageable sections.

Option Explicit

Sub Test()
Dim MyRange As Range, DelRange As Range, C As Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim NullCheck As String
Dim AC

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

SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)

Do
MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
If MatchString = "" Then
NullCheck = MsgBox("Do you really want to delete rows with empty cells?", vbYesNoCancel)
If NullCheck <> vbNo Then Exit Sub
End If
Call DelData(SearchColumn, MatchString)
Loop Until MatchString = ""

End Sub

Sub DelData(SearchColumn, MatchString)
Dim MyRange As Range, DelRange As Range, C As Range
Dim FirstAddress As String


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



Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlPart)
'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

End Sub


I hope you enjoy your visit.

[snipun]

Much appreciated. This was very helpful.

[Simon Lloyd]

If this is solved could you please mark it as such, goto your first post and just above to the right you will see thread tools, there is a mark solved button there :)