Move Row if cell is not null

[JayM]

Is it possible to use code or functions of some sort to move an entire row to
another sheet if one cell in that row is not null.

For example I have a list of users in a sheet and when they are removed from
the system i want to move them onto another row my criteria for moving them
would be to add a date in the column called Removed.

Hope this makes some sort of sense.

Any help would be greatly appreciated.

JayM - Newbie

 

[JLGWhiz]

This code is untested. You will need to change the range
parameters for the remove column to the actual column that
you intend to use. You will also have to change the
destination sheet name to your actual sheet. Place the code
in the Sheet code module for the sheet that you want the
data copied from. To access the code module, right click the
sheet tab and click "View Code" in the drop down menu.


Private Sub Worksheet_Change(ByVal Target As Range)
Set Remove = Range("C2:C100") '<<<Change to suit
If Not Intersect(Target, Remove) Is Nothing Then
If Targget <> "" And Target.DataType = xlDate Then
Target.EntireRow.Copy Sheets("Destination") _ '<<<Change
.Range("A" & Range("A65536").End(xlUP).Row + 1)
End If
End If
End Sub

The code is activated by a change to the worksheet. It will only
copy the data if the change is in a cell in the designated column
and the data in the target cell is a date. If the criteria is met,
the row on which the change is made will be copied to the next
available row on the destination sheet.

 

[JayM]

Hi
I have tried this code changing any references to my worksheet (I hope) but
it doesn't do anything at all

Here is my code
Private Sub Worksheet_Change(ByVal Target As Range)
Set Remove = Range("G:G")
If Not Intersect(Target, Remove) Is Nothing Then _
If Target <> "" And Target.DataType = xlDate Then _
Target.EntireRow.Copy Sheets("Removed") _
.Range("A" & Range("A65536").End(xlUp).Row + 1)
End If
End If
End Sub

Any help with this would be appreciated.

Jay

 

[Dave Peterson]

Your code doesn't even compile for me.

You change the block If statement to a single logical line (with the
continuation characters), but you added an extra "end if".

And .datatype doesn't apply to a range.

This worked ok for me:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Remove As Range
Dim DestCell As Range

Set Remove = Range("G:G")

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Remove) Is Nothing Then
Exit Sub
End If

If Target.Value <> "" Then
If IsDate(Target.Value) Then
With Worksheets("Removed")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
Target.EntireRow.Copy _
Destination:=DestCell
End If
End If

End Sub


Personally, I don't like the single line If statements -- except for really
small stuff, like:

If Target.Cells.Count > 1 Then Exit Sub

I find the block if statements much easier to read and modify.

 

[Per Jessen]

Hi

Try this :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Remove = Range("G:G")
If Not Intersect(Target, Remove) Is Nothing Then
If Target.Value <> "" And IsDate(Target.Value) Then
Target.EntireRow.Copy Sheets("Removed") _
.Range("A" & Range("A65536").End(xlUp).Row + 1)
End If
End If
End Sub

Regards,
Per

 

[JayM]

Dave

Thanks for this it worked a treat.

Is it possible then to delete the row from the original sheet once it has
copied to the "Removed" worksheet?

Jay

 

[Dave Peterson]

Add a couple of lines to this portion:

If Target.Value <> "" Then
If IsDate(Target.Value) Then
With Worksheets("Removed")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
Target.EntireRow.Copy _
Destination:=DestCell
Application.EnableEvents = False
Target.EntireRow.Delete
Application.EnableEvents = True
End If
End If