I have a macro that deletes rows in a column if they meet a definite value that is entered into an input box. However, the need has arisen to be able to use evaluative criteria in this input box. i.e. if a150% then delete entire row. Here is the original code that I received from these newsgroups, sorry, I can't remember the author!!

Thanks

Jeff Bertram

Sub Delete_row()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim findstring As String

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

findstring = InputBox("Enter a Search value")
If Trim(findstring) < "" Then

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, ActiveCell.Column).End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, ActiveCell.Column).Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, ActiveCell.Column).Value = findstring Then .Rows(Lrow).Delete

End If
Next
End With
End If
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

Send me a dummy sheet and I will put something together.
You need a userform rather than input boxes jumping at
you.

regards
Mark E. Philpot


see my samples at:
http://au.geocities.com/excelmarksway
http://www.geocities.com/excelmarksway
-----Original Message-----
I have a macro that deletes rows in a column if they meet
a definite value that is entered into an input box.
However, the need has arisen to be able to use evaluative
criteria in this input box. i.e. if a150% then delete
entire row. Here is the original code that I received from
these newsgroups, sorry, I can't remember the author!!

Thanks

Jeff Bertram

Sub Delete_row()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim findstring As String

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

findstring = InputBox("Enter a Search value")
If Trim(findstring) < "" Then

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count,
ActiveCell.Column).End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow,
ActiveCell.Column).Value) Then
'Do nothing, This avoid a error if
there is a error in the cell

ElseIf .Cells(Lrow,
ActiveCell.Column).Value = findstring Then .Rows
(Lrow).Delete

End If
Next
End With
End If
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
.

Hi jeffbert

With the first row as Header try this

Sub Delete_with_Autofilter()
Dim DeleteValue As String
Dim rng As Range

DeleteValue = "50%"

With ActiveSheet
.Columns(ActiveCell.Column).AutoFilter Field:=1, Criteria1:=DeleteValue
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete

End With
.AutoFilterMode = False
End With
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"jeffbert" wrote in message ...
I have a macro that deletes rows in a column if they meet a definite value that is entered into an input box. However, the need
has arisen to be able to use evaluative criteria in this input box. i.e. if a150% then delete entire row. Here is the original
code that I received from these newsgroups, sorry, I can't remember the author!!

Thanks

Jeff Bertram

Sub Delete_row()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim findstring As String

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

findstring = InputBox("Enter a Search value")
If Trim(findstring) < "" Then

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, ActiveCell.Column).End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, ActiveCell.Column).Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, ActiveCell.Column).Value = findstring Then .Rows(Lrow).Delete

End If
Next
End With
End If
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub