Deleting specific rows with a specific criteria using inputbox

[Greg]

Hi All,
I am trying to build a macro which would establish a range and criteria to
selec certain rows to delete. I have it partially working, but cant get past
this point. Can someone please show me the error of my ways! The code is
listed below, and I am sure I do not need most of it. greatly appreciate any
assistance.

Sub DeleteRows()
Dim r As Integer
Dim totalR As Integer
Dim question1 As String
Dim question2 As String
Dim question3 As String
Dim mySearch As String
Dim cell3 As Variant
Dim BadWord As Range
Dim cell1 As Range
Dim cell2 As Range
Dim cell4 As Range
Dim allCells As Range
totalR = Selection.Rows.Count
question1 = "What cell would you like to start with?"
question2 = "What what cell would you like to end with?"
question3 = "Please enter search word."
mySearch = cell3
Set cell1 = Application.InputBox(prompt:=question1, _
Title:="Range to Search", Type:=8)
Set cell2 = Application.InputBox(prompt:=question2, _
Title:="Range to Search", Type:=8)
cell1.Value = cell1.Value
cell3 = InputBox(prompt:=question3, _
Title:="Search word or phrase")
Set allCells = Range(cell1, cell2)
allCells.Value = allCells.Value
For Each cell1 In allCells
If allCells.Value <> cell3.Value Then
ActiveCell.EntireRow.Select
Selection.EntireRow.Delete
End If
Next
end sub

 

[Dave Peterson]

First, you're asking for a word, but deleting the rows that don't match that
word with this line:

If allCells.Value <> cell3.Value Then

Did you really want to delete the cells that match that word?
If allCells.Value = cell3.Value Then

Anyway...

This asks the user once for the range to search and builds a giant range based
on the cells that should be deleted. Then deletes the rows all at once.

Option Explicit
Sub DeleteRows2()
Dim r As Long
Dim RngToSearch As Range
Dim DelRng As Range
Dim WordToLookFor As String
Dim myCell As Range

Set RngToSearch = Nothing
On Error Resume Next
Set RngToSearch = Application.InputBox _
(Prompt:="select the complete range to search", Type:=8)
On Error GoTo 0

If RngToSearch Is Nothing Then
Beep
Exit Sub 'user hit cancel
End If

WordToLookFor = InputBox(Prompt:="Please enter search word.", _
Title:="Search word or phrase")

For Each myCell In RngToSearch.Cells
If LCase(myCell.Value) <> LCase(WordToLookFor) Then
If DelRng Is Nothing Then
Set DelRng = myCell
Else
Set DelRng = Union(myCell, DelRng)
End If
End If
Next myCell

If DelRng Is Nothing Then
MsgBox "No cells found, nothing deleted!"
Else
Set DelRng = Intersect(DelRng.EntireRow, DelRng.Parent.Columns(1))
DelRng.EntireRow.Delete
End If
End Sub


You may want:
If LCase(myCell.Value) <> LCase(WordToLookFor) Then
to be:
If LCase(myCell.Value) = LCase(WordToLookFor) Then



And you may want this:
Set RngToSearch = Application.InputBox _
(Prompt:="select the complete range to search", Type:=8)
to be:
Set RngToSearch = Application.InputBox _
(Prompt:="select the complete range to search", Type:=8) _
.areas(1).columns(1)

if the user is supposed to select a single column range.

 

[Greg]

Thanks Dave, this is very helpful!

First, you're asking for a word, but deleting the rows that don't match that
word with this line:

If allCells.Value <> cell3.Value Then

Did you really want to delete the cells that match that word?
If allCells.Value = cell3.Value Then

Anyway...

This asks the user once for the range to search and builds a giant range based
on the cells that should be deleted. Then deletes the rows all at once.

Option Explicit
Sub DeleteRows2()
Dim r As Long
Dim RngToSearch As Range
Dim DelRng As Range
Dim WordToLookFor As String
Dim myCell As Range

Set RngToSearch = Nothing
On Error Resume Next
Set RngToSearch = Application.InputBox _
(Prompt:="select the complete range to search", Type:=8)
On Error GoTo 0

If RngToSearch Is Nothing Then
Beep
Exit Sub 'user hit cancel
End If

WordToLookFor = InputBox(Prompt:="Please enter search word.", _
Title:="Search word or phrase")

For Each myCell In RngToSearch.Cells
If LCase(myCell.Value) <> LCase(WordToLookFor) Then
If DelRng Is Nothing Then
Set DelRng = myCell
Else
Set DelRng = Union(myCell, DelRng)
End If
End If
Next myCell

If DelRng Is Nothing Then
MsgBox "No cells found, nothing deleted!"
Else
Set DelRng = Intersect(DelRng.EntireRow, DelRng.Parent.Columns(1))
DelRng.EntireRow.Delete
End If
End Sub


You may want:
If LCase(myCell.Value) <> LCase(WordToLookFor) Then
to be:
If LCase(myCell.Value) = LCase(WordToLookFor) Then



And you may want this:
Set RngToSearch = Application.InputBox _
(Prompt:="select the complete range to search", Type:=8)
to be:
Set RngToSearch = Application.InputBox _
(Prompt:="select the complete range to search", Type:=8) _
.areas(1).columns(1)

if the user is supposed to select a single column range.