Macro to Delete Rows (multiple criteria)

jakulski

New Member
Joined
Jan 17, 2017
Messages
15
I have a worksheet consisting of approximately 50,000 rows and 30 columns (A - AD). Each column has a heading. I need a macro that will quickly delete all rows that don't contain specific text in Column C. Column C will have names of schools, elementary, middle, and high. There are approximately 225 different school options to go in each row in Column C. For each macro, I will designate 35-45 schools to keep, with all other rows being deleted. ols. Let's say that for this example, I would like to keep all rows that contain any one of the following schools in Column C (SchName): Happy Valley Elementary; Rolling Thunder Middle; Betsy Ross High; and John Glenn High.
Lev
SchID
SchName
ID
FName
LName
Grade
Gender
Ethnic
Elig
1
1
Happy Valley Elementary
1234567
Humpty
Dumpty
3
2
2
Rolling Meadow Middle
2345671
Tom
Cat
8
3
3
Tuckman County High
3456712
Jerry
Maguire
10
4
2
Rolling Thunder Middle
4567123
Buzz
Light-Year
8
5
4
Tuckman County Middle
5671234
Peter
Brady
7
6
5
John Glenn High
6712345
John
Glenn
12

<tbody>
</tbody>
 
Last edited:

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,118
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Possibly one way (loosely tested only)...
Make sure you test on a copy of your data as you are deleting.

Code:
Sub DelSchl()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False

    LR = Range("C" & Rows.Count).End(xlUp).Row

    Range("A:A").Insert

    For i = LR To 2 Step -1
        If Not IsError(Application.Match(Range("D" & i).Value, _
                                         Array("Happy Valley Elementary", "Rolling Thunder Middle", "Betsy Ross High", "John Glenn High"), 0)) Then Cells(i, 1) = 1
    Next i

    With Intersect(ActiveSheet.UsedRange, Rows(2).Resize(LR - 1))
        .Sort .Cells(1), 1, Header:=xlNo
        Range(Rows(.Cells(.Rows.Count, 1).End(3)(2).Row), .Rows(.Rows.Count)).Delete
    End With

    Range("A:A").Delete

    Application.ScreenUpdating = True
End Sub

Not sure how fast it will be as not tested.
 
Last edited:

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,988
youll have 2 sheets:
sheet1: (yours above) of the entire data list with some to be removed.
List2Keep: the list of only the names to keep

the code loads the keep list, then runs thru the entire list (sheet1, name it what you will) and marks it for deletion.
then filter the 'deletes' and press delete key.

Code:
Public Sub Mark2Keep()
Dim colKeep As New Collection
Dim sNam As String
Dim bMarkIT As Boolean


On Error GoTo errMark


   'load sheets to keep
Sheets("List2keep").Activate
Range("a1").Select
While ActiveCell.Value <> ""
   sNam = ActiveCell.Value
   colKeep.Add sNam, sNam
   ActiveCell.Offset(1, 0).Select   'next row
Wend


   'now go thru list mark those to delete
Sheets("SHEET1").Activate
Range("d2").Select
While ActiveCell.Value <> ""
   sNam = ActiveCell.Value
   bMarkIT = colKeep(sNam) <> sNam
   If bMarkIT Then ActiveCell.Value = "delete"
   
   ActiveCell.Offset(1, 0).Select   'next row
Wend


Exit Sub
errMark:
If Err = 5 Then
  bMarkIT = True
  Resume Next
End If
MsgBox Err.Description, , Err
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,135
Office Version
  1. 365
Platform
  1. Windows
If you can use the SchID rather than the SchName
How about
Code:
Sub Fltr_Del()

    ActiveSheet.Range("$A$1:$K$280").AutoFilter Field:=2, Criteria1:="<5", _
        Operator:=xlOr, Criteria2:=">10"
    Range("A2", Range("A" & Rows.Count).End(xlUp)).EntireRow.Delete
    ActiveSheet.Range("A1").AutoFilter

End Sub
 

jakulski

New Member
Joined
Jan 17, 2017
Messages
15

ADVERTISEMENT

Mark858, this worked perfectly EXCEPT that it seems I can't add all of the schools to the Array. I need to add six more schools but the curser stops and doesn't let me continue. Suggestions? Thank you in advance!
 

jakulski

New Member
Joined
Jan 17, 2017
Messages
15
Possibly one way (loosely tested only)...
Make sure you test on a copy of your data as you are deleting.

Code:
Sub DelSchl()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False

    LR = Range("C" & Rows.Count).End(xlUp).Row

    Range("A:A").Insert

    For i = LR To 2 Step -1
        If Not IsError(Application.Match(Range("D" & i).Value, _
                                         Array("Happy Valley Elementary", "Rolling Thunder Middle", "Betsy Ross High", "John Glenn High"), 0)) Then Cells(i, 1) = 1
    Next i

    With Intersect(ActiveSheet.UsedRange, Rows(2).Resize(LR - 1))
        .Sort .Cells(1), 1, Header:=xlNo
        Range(Rows(.Cells(.Rows.Count, 1).End(3)(2).Row), .Rows(.Rows.Count)).Delete
    End With

    Range("A:A").Delete

    Application.ScreenUpdating = True
End Sub

Not sure how fast it will be as not tested.


Mark858, this worked perfectly EXCEPT that it seems I can't add all of the schools to the Array. I need to add six more schools but the curser stops and doesn't let me continue. Suggestions? Thank you in advance!
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,118
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile

ADVERTISEMENT

I need to add six more schools but the curser stops

I don't know what you mean by the cursor stops, post the schools you want added.
I will also post some code to use a range with the schools.
 

jakulski

New Member
Joined
Jan 17, 2017
Messages
15
When completing this line, "Array("Happy Valley Elementary", "Rolling Thunder Middle",......."), 0)) Then Cells(I, 1) = 1", it's as if I have reached a maximum ceiling of characters -I can't add anything more. Not sure why unless there is a character limit.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,118
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Code:
Sub DelSchl()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False

    LR = Range("C" & Rows.Count).End(xlUp).Row

    Range("A:A").Insert

    For i = LR To 2 Step -1
        If Not IsError(Application.Match(Range("D" & i).Value, _
                                         Array("Happy Valley Elementary", "Rolling Thunder Middle", "Betsy Ross High", "John Glenn High", _
                                         "aaaaaa", "bbbbbb", "ccccccc", "ddddddd", "eeeeee", "fffffffffff", "ggggggggg", "hhhhhhhh", "iiiiiiiii", _
                                         "jjjjjjjj", "kkkkkkkkk", "llllllllll", "mmmmmmmm", "nnnnnnnnnn", "oooooooo", "ppppppp", "qqqqqqqq", _
                                         "rrrrrrrr", "sssssssssss", "tttttttttt", "uuuuuuuuuu", "vvvvvvvvv", "wwwwwwwwwwwww", "xxxxxxxxxx", _
                                         "yyyyyy", "zzzzzzzzz"), 0)) Then Cells(i, 1) = 1
    Next i

    With Intersect(ActiveSheet.UsedRange, Rows(2).Resize(LR - 1))
        .Sort .Cells(1), 1, Header:=xlNo
        Range(Rows(.Cells(.Rows.Count, 1).End(3)(2).Row), .Rows(.Rows.Count)).Delete
    End With

    Range("A:A").Delete

    Application.ScreenUpdating = True
End Sub
 

jakulski

New Member
Joined
Jan 17, 2017
Messages
15
Ugh...! I now have all of the schools added back in, but the entire three lines are red, starting with "If Not IsError..." until "...Then Cells(I, 1) =1". Any more suggestions? I have appreciated your help so far, Mark858.
 

Watch MrExcel Video

Forum statistics

Threads
1,132,640
Messages
5,654,535
Members
418,138
Latest member
agnesegras

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