Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Why not sort and delete all at once?
or without any selections
sub deletelessthanzero()
for i =cells(rows.count,"h").end(xlup).row to 2 step -1
if cells(i,"h")<0 then cells(i,"h").entirerow.delete
next i
end sub
--
Don Guillett
SalesAid Software

"John" wrote in message
...
Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Hi,
'---------------------------------------------------------------------
Sub test()
Dim RgToSearch As Range, cell As Range
Dim rg As Range, rg1 As Range, rg2 As Range

Set RgToSearch = Range("A:A") '<***************** change here

'quickly shortern the range to numbers only (no text...)
'This section cAN BE REMOVED IF NOT APPLICABLE
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
If rg1 Is Nothing Then
Set rg = rg2
ElseIf rg2 Is Nothing Then
Set rg = rg1
Else 'none is nothing
Set rg = Application.Union(rg1, rg2)
End If

If rg Is Nothing Then Exit Sub

'find negative numbers cells and put them in rg2
Set rg2 = Nothing
For Each rg1 In rg.Cells
If rg1.Value < 0 Then 'condition here
If rg2 Is Nothing Then 'add cell to range
Set rg2 = rg1
Else
Set rg2 = Application.Union(rg1, rg2)
End If
End If
Next

'process the delete
If Not rg2 Is Nothing Then rg2.EntireRow.Delete

End Sub
'------------------------------------------------------------------------
--
Regards,
Sébastien


"John" wrote:

Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

I don't want to sort my data at all...

sebastienm, I recieve an error that says no cells were found.



"sebastienm" wrote:

Hi,
'---------------------------------------------------------------------
Sub test()
Dim RgToSearch As Range, cell As Range
Dim rg As Range, rg1 As Range, rg2 As Range

Set RgToSearch = Range("A:A") '<***************** change here

'quickly shortern the range to numbers only (no text...)
'This section cAN BE REMOVED IF NOT APPLICABLE
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
If rg1 Is Nothing Then
Set rg = rg2
ElseIf rg2 Is Nothing Then
Set rg = rg1
Else 'none is nothing
Set rg = Application.Union(rg1, rg2)
End If

If rg Is Nothing Then Exit Sub

'find negative numbers cells and put them in rg2
Set rg2 = Nothing
For Each rg1 In rg.Cells
If rg1.Value < 0 Then 'condition here
If rg2 Is Nothing Then 'add cell to range
Set rg2 = rg1
Else
Set rg2 = Application.Union(rg1, rg2)
End If
End If
Next

'process the delete
If Not rg2 Is Nothing Then rg2.EntireRow.Delete

End Sub
'------------------------------------------------------------------------
--
Regards,
Sébastien


"John" wrote:

Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

John,

While you can modify that code, and have it work, it is much better to sort your data first based on
your deletion criteria. Excel deletes blocks of rows much more quickly than individual rows, which
you will find out when you have a lot of rows, and a lot of rows to be deleted interspersed.

For your problem, try the code below.

HTH,
Bernie
MS Excel MVP

Sub Delete0sInColH()
Dim myRows As Long
Range("A1").EntireColumn.Insert
Range("A6").FormulaR1C1 = _
"=IF(RC[8]=0,""Trash"",""Keep"")"
myRows = ActiveSheet.Range("I65536").End(xlUp).Row
Range("A6").Copy Range("A6:A" & myRows)
With Range(Range("A6"), Range("A6").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Range("A1:A5").Value = "Keep"
Cells.Select
Selection.Sort Key1:=Range("A6"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete
End Sub


"John" wrote in message
...
Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

ooops, i forgot the case when no numbers are found in section 1
Please, replace the 2 lines of code:
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
by
On Error Resume Next
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0

(and make sure you modify the top line:
Set RgToSearch = Range("A:A") '<***************** change here
to fit your range or even the current selection.
)
--
Regards,
Sébastien


"John" wrote:

I don't want to sort my data at all...

sebastienm, I recieve an error that says no cells were found.



"sebastienm" wrote:

Hi,
'---------------------------------------------------------------------
Sub test()
Dim RgToSearch As Range, cell As Range
Dim rg As Range, rg1 As Range, rg2 As Range

Set RgToSearch = Range("A:A") '<***************** change here

'quickly shortern the range to numbers only (no text...)
'This section cAN BE REMOVED IF NOT APPLICABLE
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
If rg1 Is Nothing Then
Set rg = rg2
ElseIf rg2 Is Nothing Then
Set rg = rg1
Else 'none is nothing
Set rg = Application.Union(rg1, rg2)
End If

If rg Is Nothing Then Exit Sub

'find negative numbers cells and put them in rg2
Set rg2 = Nothing
For Each rg1 In rg.Cells
If rg1.Value < 0 Then 'condition here
If rg2 Is Nothing Then 'add cell to range
Set rg2 = rg1
Else
Set rg2 = Application.Union(rg1, rg2)
End If
End If
Next

'process the delete
If Not rg2 Is Nothing Then rg2.EntireRow.Delete

End Sub
'------------------------------------------------------------------------
--
Regards,
Sébastien


"John" wrote:

Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Thanks

"sebastienm" wrote:

ooops, i forgot the case when no numbers are found in section 1
Please, replace the 2 lines of code:
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
by
On Error Resume Next
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0

(and make sure you modify the top line:
Set RgToSearch = Range("A:A") '<***************** change here
to fit your range or even the current selection.
)
--
Regards,
Sébastien


"John" wrote:

I don't want to sort my data at all...

sebastienm, I recieve an error that says no cells were found.



"sebastienm" wrote:

Hi,
'---------------------------------------------------------------------
Sub test()
Dim RgToSearch As Range, cell As Range
Dim rg As Range, rg1 As Range, rg2 As Range

Set RgToSearch = Range("A:A") '<***************** change here

'quickly shortern the range to numbers only (no text...)
'This section cAN BE REMOVED IF NOT APPLICABLE
Set rg1 = RgToSearch.SpecialCells(xlCellTypeConstants, 1)
Set rg2 = RgToSearch.SpecialCells(xlCellTypeFormulas, 1)
If rg1 Is Nothing Then
Set rg = rg2
ElseIf rg2 Is Nothing Then
Set rg = rg1
Else 'none is nothing
Set rg = Application.Union(rg1, rg2)
End If

If rg Is Nothing Then Exit Sub

'find negative numbers cells and put them in rg2
Set rg2 = Nothing
For Each rg1 In rg.Cells
If rg1.Value < 0 Then 'condition here
If rg2 Is Nothing Then 'add cell to range
Set rg2 = rg1
Else
Set rg2 = Application.Union(rg1, rg2)
End If
End If
Next

'process the delete
If Not rg2 Is Nothing Then rg2.EntireRow.Delete

End Sub
'------------------------------------------------------------------------
--
Regards,
Sébastien


"John" wrote:

Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Thanks again to you both for the help

"Bernie Deitrick" wrote:

John,

While you can modify that code, and have it work, it is much better to sort your data first based on
your deletion criteria. Excel deletes blocks of rows much more quickly than individual rows, which
you will find out when you have a lot of rows, and a lot of rows to be deleted interspersed.

For your problem, try the code below.

HTH,
Bernie
MS Excel MVP

Sub Delete0sInColH()
Dim myRows As Long
Range("A1").EntireColumn.Insert
Range("A6").FormulaR1C1 = _
"=IF(RC[8]=0,""Trash"",""Keep"")"
myRows = ActiveSheet.Range("I65536").End(xlUp).Row
Range("A6").Copy Range("A6:A" & myRows)
With Range(Range("A6"), Range("A6").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Range("A1:A5").Value = "Keep"
Cells.Select
Selection.Sort Key1:=Range("A6"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete
End Sub


"John" wrote in message
...
Can this piece of code be adapted easily to delete a row when the active
cell value is less than 0?

Range("h6:h700").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(3)

Set rngFound = rngToSearch.Find("-")
If rngFound Is Nothing Then
MsgBox "No Deletions Found"
Else
Do
rngFound.EntireRow.Delete

Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub