Copy Entire Row if Column Value is Negative

[jammer6_9]

How can I code this;

If Range(E9).value is Negative then Copy Entire Row9 to Row 160

[mbarron]

This will move row 9 to row 160 if E9 is less than 0


If Range("E9")<0 Then
Range("E9").EntireRow.Cut Destination:=Range("A160")
End If

[jammer6_9]

Perfect! Now what I want is check the entire Column E then copy all negative rows from Range A:160 going down. Is this possible


This will move row 9 to row 160 if E9 is less than 0


If Range("E9")<0 Then
Range("E9").EntireRow.Cut Destination:=Range("A160")
End If

[mbarron]

Does this do what you want?


Sub CopyColNegs()
Dim iDestRow As Long, i As Long
iDestRow = 160
For i = 2 To 159 'change numbers to the range of rows you are checking
If Range("e" & i) < 0 Then
Range("e" & i).EntireRow.Copy _
Destination:=Range("a" & iDestRow)
iDestRow = iDestRow + 1
End If
Next
End Sub

The first version cut and pasted, this will copy and paste.

[jammer6_9]

:bug: Thats great! Just one last thing, what about looking on a specified range only. Something like Range("e18:e25")


Does this do what you want?


Sub CopyColNegs()
Dim iDestRow As Long, i As Long
iDestRow = 160
For i = 2 To 159 'change numbers to the range of rows you are checking
If Range("e" & i) < 0 Then
Range("e" & i).EntireRow.Copy _
Destination:=Range("a" & iDestRow)
iDestRow = iDestRow + 1
End If
Next
End Sub

The first version cut and pasted, this will copy and paste.

[mbarron]

Change the numbers in this line:

For i = 2 To 159

to the row numbers you want to check.

From your last post, the line would be:

For i = 18 to 25

[jammer6_9]

Thanks a lot.:friends:

[jammer6_9]

Hi I came to this code. My only problem is where to put the code. It really takes time when I call the procedure into;

Worksheet_Calculate
Worksheet_Change
Worksheet_SelectionChange



Sub CopyColNegs()

Dim iDestRow As Long, i As Long
iDestRow = 210

For i = 9 To 196
If Range("e" & i) < 0 Then
Range("e" & i).EntireRow.Copy _
Destination:=Range("a" & iDestRow)
iDestRow = iDestRow + 1

End If
Next

Range("a159").Activate

End Sub

[Bob Phillips]

Maybe this



Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "E9:E196" '<== change to suit
Dim iDestRow As Long, i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

iDestRow = Range("A1").End(xldwn).Row + 1
If Me.Range("E" & Target.Row) < 0 Then
Target.EntireRow.Copy _
Destination:=Range("A" & iDestRow)
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub


This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

[jammer6_9]

It does not copy negative row values to the destination.

[Bob Phillips]

Try this instead



Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "E9:E196" '<== change to suit
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

If Me.Range("E" & Target.Row) < 0 Then
Target.EntireRow.Copy _
Destination:=Range("A210")
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub

[jammer6_9]

still it does not work.

[Bob Phillips]

It did for me so I am out of ideas.

[jammer6_9]

I am attaching the file. I will appreciate it if you could look at it.:banghead:

[Bob Phillips]

You didn't mention the formula,



Private Sub Worksheet_Calculate()
Const WS_RANGE As String = "E9:E196" '<== change to suit
Dim i As Long

For Each cell In Me.Range(WS_RANGE)

If cell.Value < 0 Then
cell.EntireRow.Copy Destination:=Range("A210")
Exit For
End If
Next cell

End Sub

[jammer6_9]

Hi thanks for the response. Code below copy the first negative row not all negative row.


You didn't mention the formula,



Private Sub Worksheet_Calculate()
Const WS_RANGE As String = "E9:E196" '<== change to suit
Dim i As Long

For Each cell In Me.Range(WS_RANGE)

If cell.Value < 0 Then
cell.EntireRow.Copy Destination:=Range("A210")
Exit For
End If
Next cell

End Sub

[geekgirlau]

Private Sub Worksheet_Calculate()
Const WS_RANGE As String = "E9:E196" '<== change to suit
Dim i As Long

For Each cell In Me.Range(WS_RANGE)
If cell.Value < 0 Then
cell.EntireRow.Copy Destination:=Range("A210").Offset(i, 0)
i = i + 1
End If
Next cell
End Sub

[jammer6_9]

This gives me what I require but it takes time to finish as I have raise on the post no.8.



Private Sub Worksheet_Calculate()
Const WS_RANGE As String = "E9:E196" '<== change to suit
Dim i As Long

For Each cell In Me.Range(WS_RANGE)
If cell.Value < 0 Then
cell.EntireRow.Copy Destination:=Range("A210").Offset(i, 0)
i = i + 1
End If
Next cell
End Sub

[geekgirlau]

A couple of questions spring to mind:

Is it really necessary for this to happen every time the sheet calculates?
Have you considered using a filter instead? You can set up an advanced filter with your criteria, and have it automatically copy the results to a specific range.

[jammer6_9]

Yes my main objective was like refreshing the summary or copied rows when it calculate but I guess it is impossible now.

I haven't considered using a filter supposing that it is not possible applying this method.


A couple of questions spring to mind:

Is it really necessary for this to happen every time the sheet calculates?
Have you considered using a filter instead? You can set up an advanced filter with your criteria, and have it automatically copy the results to a specific range.

[geekgirlau]

Wherever possible, it's a good idea to use built-in functionality to do what you want rather than reinventing the wheel. Generally your code will be smaller, and the procedure will happen much faster than anything you write yourself. Using a filter, the code is simply


Range("MyData").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("MyCrit"), _
CopyToRange:=Range("MyNegatives"), _
Unique:=False


I've attached a small sample so you can see it in action. Just a couple of things to note:

You can either used a named range or cell addresses for this (I'm a fan of names myself).
The criteria range should have the field name for column E, and the criteria (<0).
The "copy to" range should have all the field names you want copied. If you only want 3 out of 10 fields extracted, only list the 3 you want.You also need to think about when you really NEED the summary to be updated. To give an example, I recently had a workbook that required that some code be run to do some fancy stuff to a chart, which was on a separate chart sheet. While it may be tempting to run this each time the relevant data was affected, I only NEEDED it to run when the chart sheet was activated.

Depending on what you are changing, you could be triggering both the Change and Calculate event for the sheet one after the other, which means your procedure is running at least twice. If you don't remember to turn off EnableEvents, you may be triggering the procedure multiple times in a nested sequence - this may explain why it's taking so long.