If yes, then move row to another sheet

[Ambs80]

Hello

I am aware that this has been asked before, but I have not been able to get it to work, therefore this new question.

I have an excel document with 2 sheets "Open" and "Closed" this refers to open and closed cases.
The document uses column A-G, where G is a dropdown menu with "Yes" or "No"
What I need the vba code to do, is when I choose "Yes", then it cuts the selected row from and past it into the "Closed" sheet starting from the A row.

Can someone help me this problem?

Best regards,
André

 

[Truiz]

You want the code to perform the action as soon as a selection is performed on column "G"???????? or use it with a button or something else?

 

[JLGWhiz]

If you mean you want to paste data to a closed workbook, I don't believe you will find an easy answer. It can probably be done with some advanced programming, but in general, a file must be open to write to it. Most of the code that I have seen will temporarily open the closed workbook, do the pasting task, then close the destination workbook. Is there some reason why that would not work for you?

 

[Truiz]

This might seem like to much but got it to work

So on the sheet code put this

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("[COLOR=#ff0000]G2:G1000[/COLOR]")) Is Nothing Then
Call MoveInfo
End If
End Sub

add a module to the workbook and write this

Sub MoveInfo()Dim lRow, iCntr, lRow2 As Long


With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
     .EnableEvents = False
End With


lRow = Sheets("[COLOR=#ff0000]Open[/COLOR]").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row


    For iCntr = 2 To lRow
    lRow2 = Sheets("[COLOR=#ff0000]Closed[/COLOR]").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
        If Cells(iCntr, "G") = "[COLOR=#ff0000]Yes[/COLOR]" Then
            Range(Cells(iCntr, "A"), Cells(iCntr, "G")).Copy Sheets("[COLOR=#ff0000]Closed[/COLOR]").Cells(lRow2 + 1, "A")
            Rows(iCntr).Delete
        End If
    Next
Application.CutCopyMode = False


With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
     .EnableEvents = True
End With


End Sub

Change all red fonts to fit your needs

 

[JLGWhiz]

I think maybe you could do it with just the Worksheet_Change event.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Value = "Yes" Then
    If Not Intersect(Range("G:G"), Target) Is Nothing Then
        Target.EntireRow.Cut Sheets("Closed").Cells(Rows.Count, 1).End(xlUp)(2)
    End If
End If
Application.EnableEvents = True
End Sub

I misread the OP.

 

[Ambs80]

Thank you very much JLGWhiz, it moves the row! One thing I am missing though, is to delete the blank row left in the "open" sheet. Is that possible?

Best regards,
André

 

[JLGWhiz]

Thank you very much JLGWhiz, it moves the row! One thing I am missing though, is to delete the blank row left in the "open" sheet. Is that possible?

Best regards,
André

See if this works for you

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim r As Long
Application.EnableEvents = False
If Target.Value = "Yes" Then
    r = Target.Row
    If Not Intersect(Range("G:G"), Target) Is Nothing Then
        Target.EntireRow.Cut Sheets("Closed").Cells(Rows.Count, 1).End(xlUp)(2)
        Rows(r).Delete xlShiftUp
    End If    
End If
Application.EnableEvents = True
End Sub