'удалить строки, у которых в 1-м столбце значение не "Level 2"
Sub example_01_1()
Dim i As Long, r As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")
 With .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
 Set r = .Find("Level 2", lookat:=xlWhole)
 If Not r Is Nothing Then .ColumnDifferences(r).EntireRow.Delete
 End With
End With
Application.ScreenUpdating = True
End Sub

Sub example_01_2()
Dim i&, r As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")
 With .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
 .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlYes
 Set r = .Find("Level 2", lookat:=xlWhole)
 If Not r Is Nothing Then .ColumnDifferences(r).EntireRow.Delete
 End With
End With
Application.ScreenUpdating = True
End Sub

Sub example_02_1()
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
 .Parent.AutoFilterMode = False
 .AutoFilter Field:=1, Criteria1:="<>Level 2"
 .Offset(1).EntireRow.Delete
 .AutoFilter
 .Parent.UsedRange
End With
Application.ScreenUpdating = True
End Sub

Sub example_02_2()
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
 .Parent.AutoFilterMode = False
 .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
 .AutoFilter Field:=1, Criteria1:="<>Level 2"
 .Offset(1).EntireRow.Delete
 .AutoFilter
 .Parent.UsedRange
End With
Application.ScreenUpdating = True
End Sub

Sub example_03()
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
 .Offset(, .Columns.Count).Resize(, 1).FormulaR1C1 = "=IF(RC[-3]<>""Level 2"","""",1)"
 With .CurrentRegion
 .Sort Key1:=.Cells(1, .Columns.Count), Order1:=xlAscending, Header:=xlYes
 .Columns(.Columns.Count).Offset(1).SpecialCells(-4123, 2).EntireRow.Delete 'Specialcells 8192 limit and non contiguous range
 .Columns(.Columns.Count).ClearContents
 End With
End With: Application.ScreenUpdating = True
End Sub

'а теперь удаляем строки с "Level 2" в 1-м столбце
Sub example_04()
Dim i As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
 With .Range("A1:C" & .Cells(Rows.Count, 1).End(xlUp).Row)
 .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlYes
 i = WorksheetFunction.CountIf(.Columns(1), "Level 2")
 .Columns(1).Find("Level 2", lookat:=xlWhole).Resize(i).EntireRow.Delete
 End With
 .UsedRange
End With
Application.ScreenUpdating = True
End Sub

Sub example_05()
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
 .Columns(1).Replace "Level 2", Empty
 .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlYes
 .Columns(1).SpecialCells(4).EntireRow.Delete
 .Parent.UsedRange
End With
Application.ScreenUpdating = True
End Sub

'медленно удаляем строки с "Level 2" в 1-м столбце (до ~1000 строк)
Sub example_06()
Dim x, i As Long, rDel As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")
 Set rDel = .Range("B1")
 x = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Value
 For i = 1 To UBound(x)
 If x(i, 1) = "Level 2" Then Set rDel = Union(rDel, .Cells(i, 1))
 Next i
 If rDel.Count > 1 Then Intersect(.Columns(1), rDel).EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub

'еще медленнее удаляем строки с "Level 2" в 1-м столбце (до ~200 строк)
Sub example_07()
Dim i As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
 For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
 If .Cells(i, 1) = "Level 2" Then .Cells(i, 1).EntireRow.Delete
 Next i
End With
Application.ScreenUpdating = True
End Sub

Sub example_08()
On Error Resume Next
With Range("A1", Cells(Rows.Count, 1).End(xlUp))
 .Value = Evaluate("IF(" & .Address & "=""Level 2"",""""," & .Address & ")")
 .SpecialCells(4).EntireRow.Delete
End With
End Sub