# Deleting certain rows in 95,000 row worksheet

#### bthurman1220

##### New Member
I am using the code below to search cells for certain criteria and then keeping certain
rows and deleting certain rows.

This code currently takes around 1 hour to process 95,000 records. I need help in
determining if there is a better way.

Thanks,

Code:
``````'Delete Level 1's and certain Level 2's
X = 2
Dim vLvlDel As Long
vLvlDel = 1
Do Until Cells(X, 1) = ""

vLvl = Cells(X, 14)
vJobCode = Cells(X, 16)
Application.StatusBar = "Working on Row " & vLvlDel

Select Case vLvl
Case "Level 1"
Cells(X, 1).EntireRow.Delete
Case "Level 3"
X = X + 1
Case "Level 4"
X = X + 1
Case "Level 2"
Select Case vJobCode
Case "10127"
X = X + 1
Case "10205"
X = X + 1
Case "10206"
X = X + 1
Case "11414"
X = X + 1
Case "11428"
X = X + 1
Case "11754"
X = X + 1
Case "11769"
X = X + 1
Case Else
Cells(X, 1).EntireRow.Delete
End Select

End Select

vLvlDel = vLvlDel + 1

Loop

MsgBox vLvlDel & " Rows Processed"``````

### Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

#### Fluff

##### MrExcel MVP, Moderator
Code:
``````Sub bthurman()
Dim Cl As Range, Rng As Range

For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
If Cl.Offset(, 13).Value = "Level 1" Then
If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
ElseIf Cl.Offset(, 13).Value = "Level 2" Then
Select Case Cl.Offset(, 15).Value
Case "10127", "10205", "10206", "11414", "11428", "11754", "11769"
Case Else
If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
End Select
End If
Next Cl
If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub``````

• bthurman1220

#### bthurman1220

##### New Member
Code:
``````Sub bthurman()
Dim Cl As Range, Rng As Range

For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
If Cl.Offset(, 13).Value = "Level 1" Then
If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
ElseIf Cl.Offset(, 13).Value = "Level 2" Then
Select Case Cl.Offset(, 15).Value
Case "10127", "10205", "10206", "11414", "11428", "11754", "11769"
Case Else
If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
End Select
End If
Next Cl
If Not Rng Is Nothing Then Rng.EntireRow.Delete

End Sub``````

Thanks so much Fluff - I will give this a try and let you know.

#### bthurman1220

##### New Member
Thanks so much Fluff. Your code trimmed 35 minutes off the processing time.

#### Fluff

##### MrExcel MVP, Moderator
You're welcome & thanks for the feedback.