Thanks Dave, this is very helpful!
"Dave Peterson" wrote:
> 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 wrote:
> >
> > 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
>
|