Excel macro to delete rows with multiple criteria

pleasefreeus

New Member
Joined
Jan 12, 2010
Messages
11
Hi. I am using Excel 2003 on windows XP.

I am trying to come up with a macro to delete all rows that have Total, Period, Sequence, or : anywhere in in the row. I don't know which rows will have these words, and I don't know how many lines total there will be to search through. Also I need the search to start on line 18 because I need to keep these rows from 1-17.

I am pretty new to macros and I have found code on this website that is close to this, but none seem to be perfect and I am not sure how to change them to make them work.

Any help will be greatly appreciated.
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Tom Urtis

MrExcel MVP
Joined
Feb 10, 2002
Messages
11,206
Is this for a particular column (if so, which column) or anywhere on the worksheet...

and


...does the column / do the columns (depending on yoru answer to the first item) sometimes contain blank cells or are all cells supposed to contain something...

and

...what if a cell contains "I said: Hello" with the ":" character in there - - should that or should that not qualify.
 

pleasefreeus

New Member
Joined
Jan 12, 2010
Messages
11
All of the data is in column A.

There are blank cells, but at this point in the macro I have already sorted column A so all the blank cells should be at the bottom.

Any cell in Column A with a ":" qualifies to have the entire row deleted. So your example would qualify.
 

crook_101

Well-known Member
Joined
Oct 20, 2008
Messages
682
Hi,

The following may help you on your way....

Code:
Sub DeleteRowTool()
Dim rRange As Range
Dim strCriteria As String
Dim lCol As Long
Dim rHeaderCol As Range
Dim xlCalc As XlCalculation
Const strTitle As String = "Row Delete Tool"
    On Error Resume Next
Step1:
        Set rRange = Application.InputBox(Prompt:="Select range including header range" _
        , Title:=strTitle & " Step 1 of 3", Default:=ActiveCell.CurrentRegion.Address, Type:=8)
        
        If rRange Is Nothing Then Exit Sub
         Application.GoTo rRange.Rows(1), True
    
Step2:
        lCol = Application.InputBox(Prompt:="Please enter relative column number of evaluation column" _
        , Title:=strTitle & " Step 2 of 3", Default:=1, Type:=1)
        
        If lCol = 0 Then Exit Sub
Step3:
        strCriteria = InputBox(Prompt:="Please enter a single criteria." & _
        vbNewLine & "Eg >5 OR <10 OR Cat* OR *Cat OR *Cat*" _
        , Title:=strTitle & " Step 3 of 3")
        
    If strCriteria = vbNullString Then Exit Sub
    
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
        
    ActiveSheet.AutoFilterMode = False
    
    With rRange
      .AutoFilter Field:=lCol, Criteria1:=strCriteria
      .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    ActiveSheet.AutoFilterMode = False
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   On Error GoTo 0
End Sub

Cheers,
Ian
 

pleasefreeus

New Member
Joined
Jan 12, 2010
Messages
11

ADVERTISEMENT

Thank you for this code. I have a couple of questions. Please forgive me, because I am new to code.

1. Is there anything in this code that says to start with row 18?

2. Where do I need to enter the criteria?
 

Tom Urtis

MrExcel MVP
Joined
Feb 10, 2002
Messages
11,206
See if this does what you want.


Sub Test1()
Application.ScreenUpdating = False

Dim myArray As Variant, LastRow&, FilterRange As Range, strBogus$, i%
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set FilterRange = Range("A17:A" & LastRow)
strBogus = "zzzyyyxxx"
ActiveSheet.AutoFilterMode = False

myArray = Array("Total", "Period", "Sequence", ":")
For i = LBound(myArray) To UBound(myArray)
FilterRange.Replace What:=myArray(i), Replacement:=strBogus, LookAt:=xlPart, MatchCase:=False
Next i

FilterRange.AutoFilter Field:=1, Criteria1:="*" & strBogus & "*"
On Error Resume Next
FilterRange.SpecialCells(12).EntireRow.Delete
Err.Clear

ActiveSheet.AutoFilterMode = False
Set FilterRange = Nothing
Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,109,033
Messages
5,526,368
Members
409,697
Latest member
christopherlewis1620

This Week's Hot Topics

Top