Move entire row from one sheet to another based on cell value & delete the original row

[ceciliacrawford]

Move entire row from one sheet to another based on cell value.
I am trying to setup my spreadsheet so that when a row’s status in one sheet (Dashboard) is changed to “Closed,” the entire row is copied, deleted and then placed in another sheet (Completed).

Everything is working except for the “deleting” the original cell in the Dashboard sheet.

I hope I explained in enough detail. Please look at my code and see what I am doing wrong! I also attached my excel spreadsheet.

Sub cuttosheet()
Dim sRng As Range, cell As Range
Dim dRng As Range
Set sRng = Sheets("Dashboard").Range([A1], [A65536].End(xlUp))
For Each cell In sRng
If cell.Value = "Closed" Then
Set dRng = Sheets("Completed").[A65536].End(xlUp)(2, 1)
cell.EntireRow.Cut dRng
End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A65536")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim NR As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "closed"
      Range("A" & Target.Row & ":Q" & Target.Row).Copy Worksheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      Target.EntireRow.Delete Shift:=xlUp
   End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

Sub MoveMe(rTarget As Range)
    Dim wsMoveTo    As Worksheet
    Dim rMoveToRow  As Range
    Dim rCopyFrom   As Range
    Dim rCopyTo     As Range
    Dim rItem       As Range
    Dim rMoveUp     As Range
    Dim bEvents     As Boolean
    Dim bScrUpd     As Boolean
    Dim lCalc       As Long
    
    With Application
        bEvents = .EnableEvents
        bScrUpd = False
        lCalc = .Calculation
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Select Case rTarget.Text
        Case "closed"
            Set wsMoveTo = Sheets(rCompleted)
        Case Else
            Exit Sub
    End Select
    Set rMoveToRow = wsMoveTo.Cells.Find("Potential", LookIn:=xlValues, LookAt:=xlWhole).End(xlUp).Offset(1)
    Set rCopyFrom = Range(Cells(rTarget.Row, "A"), Cells(rTarget.Row, "Q"))
    Set rCopyTo = wsMoveTo.Range(wsMoveTo.Cells(rMoveToRow.Row, "A"), wsMoveTo.Cells(rMoveToRow.Row, "Q"))
    rCopyTo.Formula = rCopyFrom.Formula
    Set rMoveUp = Range(Cells.Find("Potential", LookIn:=xlValues, _
        LookAt:=xlWhole).End(xlUp).Offset(1), rCopyFrom)
    rMoveUp.Formula = rMoveUp.Offset(1).Formula

    
    Set wsMoveTo = Nothing
    Set rMoveToRow = Nothing
    Set rCopyFrom = Nothing
    Set rCopyTo = Nothing
    
    With Application
        .EnableEvents = bEvents
        .ScreenUpdating = bScrUpd
        .Calculation = lCalc
    End With
End Sub

Thanks!!!

[arlu1201]

Try this code

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("A:A")) Is Nothing Then
    If Range("A" & Target.Row).Value = "Closed" Then
        Target.EntireRow.Copy Worksheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
    End If
End If
End Sub

Right click on the Dashboard sheet and select View Code. Copy this code over. Each time you type "Closed" in column A, it will move the row.

[ceciliacrawford]

Rows clears as before, but are not deleting and shifting up.
Thanks

[arlu1201]

It does move up. I just tested it at my end and it works. Please try again and let me know.

[ceciliacrawford]

Tried again and mine still isn't moving up. Can you upload the file that works? So, I can see what I am doing wrong. I really do appreciate your help.

[arlu1201]

Here is my version. Just put in Closed (type it out) in column A and when you press enter, the row vanishes.

[ceciliacrawford]

IT'S WORKING...you are a genius!!! THANK YOU SOOOOO MUCH!!!!!
Cecilia

[arlu1201]

Based on your last post in this thread, its apparent that you are satisfied with the solution(s) you've received and have solved your question, but you haven't marked your thread as "SOLVED". I will do it for you this time.

In future, to mark your thread as Solved, you can do the following -
Select Thread Tools-> Mark thread as Solved.

Incase your issue is not solved, you can undo it as follows -
Select Thread Tools-> Mark thread as Unsolved.

Also, since you are relatively new to the forum, i would like to inform you that you can thank those who have helped you by clicking the small star icon located in the lower left corner of the post which helped you. This adds to the reputation of the person who has taken the time to help you.

[dhavalthe1]

thank u so much arlu1201