Move row to another worksheet base on a cell value

[Lilleyj]

Hi There,

In coloumn D i have a data validation list (N,Y,NA). If "N" is selected I want the entire row to move to the worksheet called "Declined Referrals".

How can i do this?

Many thanks
Jess

[Mumps1]

Hi Jess. Try:

Sub MoveRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("D2:D" & LastRow)
        If rng = "N" Then
            rng.EntireRow.Copy Sheets("Declined Referrals").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            rng.EntireRow.Delete
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

[Lilleyj]

Hi there,

Thank you for your quick response. Doesn't seem to work though :/

[JOHN H. DAVIS]

Maybe:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(4)) Is Nothing Then
    If Target.Value = "N" Then
        Rows(Target.Row).Copy Sheets("Declined Referrals").Range("A" & Rows.count).End(3)(2)
    End If
End If
End Sub

[Lilleyj]

That worked great, thank you. Is there a way to remove it from the original worksheet once it has been copied to the 'Declined Referrals'.

Many thanks
Jess

[JOHN H. DAVIS]

Maybe:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(4)) Is Nothing Then
    If Target.Value = "N" Then
        Rows(Target.Row).Copy Sheets("Declined Referrals").Range("A" & Rows.count).End(3)(2)
        Rows(Target.Row).delete
    End If
End If
End Sub

[Lilleyj]

Brilliant, thank you

[Lilleyj]

Sorry spoke too soon. It is showing run-time error '13' - Type mismatch. When i press debug it is highlighting "If Target.Value = "N" Then

[JOHN H. DAVIS]

Change too: If Target.Text = "N"

[Lilleyj]

Hi,

What does the End(3)(2) do? Only I have copied the code to use in a new spreadsheet and it has come up with run-time error 9. This is teh new code



Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(13)) Is Nothing Then
If Target.Text = "Blue" Then
Rows(Target.Row).Copy Sheets("Embedded as Business as Usual").Range("A" & Rows.Count).End(3)(2)
Rows(Target.Row).Delete
End If
End If
End Sub

[JOHN H. DAVIS]

It places the copied row on the destination sheet to the first in ununsed cell in Column A. Check your destination Sheets name. Spelling, spaces ect.

[Lilleyj]

*blushes* whooops you were right.

sorry and thank you

[Lilleyj]

EAU3_Patient_Status_2014.xlsm

Thank you

[JOHN H. DAVIS]

Umm. You have merged cells in your sheets, which can cause problems. Can something like this help?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(8)) Is Nothing Then
    If Target.Text = "N" Then
        Range(Cells(Target.Row, "D"), Cells(Target.Row, "X")).Copy Sheets("Declined Referrals").Range("D" & Rows.Count).End(3)(2)
         Rows(Target.Row).Delete
    End If
End If
End Sub

[Lilleyj]

Sorry, it's still deleting rows

[JOHN H. DAVIS]

This one is working for me on the sample provided?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(8)) Is Nothing Then
    If Target.Text = "N" Then
        Range(Cells(Target.Row, "D"), Cells(Target.Row, "X")).Copy Sheets("Declined Referrals").Range("D" & Rows.Count).End(3)(2)
        Range(Cells(Target.Row, "D"), Cells(Target.Row, "X")).Delete
    End If
End If
End Sub

I also changed this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Columns(24)) Is Nothing Then
    If Target.Text = "Discharged" Then
        Range(Cells(Target.Row, "D"), Cells(Target.Row, "X")).Copy Sheets("Archived EAU3 Patients").Range("D" & Rows.Count).End(3)(2)
        Range(Cells(Target.Row, "D"), Cells(Target.Row, "X")).Delete
    End If
End If
End Sub

[Lilleyj]

EAU3_Patient_Status_2014.xlsm

Cheers

[Lilleyj]

It's very strange as it was working perfectly before. I'll attach my one again.

[JOHN H. DAVIS]

Try it now.

[Lilleyj]

Sorry it's still doing it but this time with run-time error '1004': method 'intersect of object_global'failed. Could it be my computer because it used to work fine?

Thank you

[JOHN H. DAVIS]

I dunno. It works on mine?

[Lilleyj]

I've worked it out, it's happening when A1 is blank on the previously copied across row, so it thinks teh whole row is blank and pastes over it. Can we ask it to check if column B is empty?

Many thanks
Jess

[JOHN H. DAVIS]

I'm not sure what you mean? The code provided is relative too what's in Column D not A or B, because on your spreadsheets Columns A,B and C are merged.