View Full Version : Solved: Delete Row based on Column Criteria (with looping)
snipun
03-18-2011, 02:03 PM
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
03-18-2011, 03:07 PM
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
03-18-2011, 03:14 PM
Welcome to VBAX
Can you post a workbook with sample data? Use Manage Attachments in the Go Advanced reply section
snipun
03-18-2011, 03:18 PM
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
03-18-2011, 04:08 PM
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
04-21-2011, 12:36 PM
Much appreciated. This was very helpful.
Simon Lloyd
04-21-2011, 12:55 PM
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 :)
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.