Sub DeleteRowslessthan10()
Dim rg As Range
Dim i As Long
On Error Resume Next
Set rg = Application.InputBox("Please select a single column range of cells." & vbLf & _
        "If value is Less than 10,that row will be deleted.", _
        Default:="D2:D3000", Type:=8)
On Error GoTo 0

Application.ScreenUpdating = False
If Not rg Is Nothing Then
    Set rg = Intersect(rg, ActiveSheet.UsedRange)
    If Not rg Is Nothing Then
        For i = rg.Rows.Count To 1 Step -1
            If IsError(rg.Cells(i, 1).Value) Then
                rg.Rows(i).EntireRow.Delete
            ElseIf UCase(rg.Cells(i, 1).Value) = "N/A" Then
                rg.Rows(i).EntireRow.Delete
            ElseIf rg.Cells(i, 1).Value = "" Then
            ElseIf IsNumeric(rg.Cells(i, 1)) Then
                If rg.Cells(i, 1).Value < 11 Then rg.Rows(i).EntireRow.Delete
            End If
        Next
    End If
End If
End Sub