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.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Tom Urtis

MrExcel MVP
Joined
Feb 10, 2002
Messages
11,273
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,273
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,168,031
Messages
5,856,937
Members
431,841
Latest member
jaybeem

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top