G
Guest
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 a1>50% 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
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