Conditional Copy, Paste to Another Sheet, Return to Start

[Philip1957]

Greetings,

I have a Workbook for tracking change orders. When an ECO is closed, I select any cell in the row and run the following to erase the data and clear the formatting on that row.

Sub Clear_ECO()
MSG1 = MsgBox("This action cannot be undone!" & vbCrLf & vbCrLf & "Selected Row is: " & ActiveCell.Row, 1, "CAUTION!")


Application.ScreenUpdating = False

If MSG1 = vbOK Then

    'Select row
        ActiveCell.EntireRow.Select

    'Return to Blank Format
        Selection.Interior.Color = xlNone
        Selection.Font.Strikethrough = False
        Selection.Font.ColorIndex = 0
        Selection.ClearContents
End If

Application.ScreenUpdating = True

End Sub

This works just fine.

I will be out of the office for an extended period of time and a colleague will be covering this for me. On my return, I will need to review some of the ECOs (indicated by an x in column O) that closed during my absence. I am trying to modify my macro above so that it will conditionally copy the active row from WS "Tracking" if there is an X in column O and paste it to WS "Archive", then return to "Tracking" to clear the data and formatting. This way I'll have a list of the relevant closed change orders when I get back.

I have been playing around with variations on the following with no luck at all. I can't even seem to get it to find the X in column O, which is frustrating because it seems like it should be easy.

Sub New_Clear()

Dim Rtn As Range

MSG1 = MsgBox("This action cannot be undone!" & vbCrLf & vbCrLf & "Selected Row is: " & ActiveCell.Row, 1, "CAUTION!")


Application.ScreenUpdating = False

If MSG1 = vbOK Then

    'Select row
        ActiveCell.EntireRow.Select
        Set Rtn = ActiveRow
        
    'Copy Record of Closed ECO with Documents to Archive tab
        If ActiveRow.Range("O").Value = "X" Then
            ActiveRow.Copy Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1).Paste
        End If

    'Return to Blank Format
        Sheets("Tracking").Rtn.Select
        Selection.Interior.Color = xlNone
        Selection.Font.Strikethrough = False
        Selection.Font.ColorIndex = 0
        Selection.ClearContents

Application.ScreenUpdating = True

End Sub

Any assistance with this would be greatly appreciated.

Thanks,
~ Phil

 

[mumps]

Try:

Sub New_Clear()
    Application.ScreenUpdating = False
    If Range("O" & ActiveCell.Row) <> "X" Then
        MsgBox ("Row " & ActiveCell.Row & " does not contain 'X' in column O.")
        Exit Sub
    End If
    If MsgBox("This action cannot be undone!" & vbCrLf & vbCrLf & "The data in row " & ActiveCell.Row & " will be cleared. Are you sure?", vbYesNo) = vbYes Then
        Rows(ActiveCell.Row).Copy Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
        With Rows(ActiveCell.Row)
            .Interior.Color = xlNone
            .Font.Strikethrough = False
            .Font.ColorIndex = 0
            .ClearContents
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[Philip1957]

mumps,

Thanks for the rapid response.

I guess I didn't do a good job of articulating what I was trying to accomplish. I need the row to clear regardless of whether there is an X in column O, but I need to make a copy before clearing if there is an X in column O.

However your suggested code did help me get my thoughts straightened out and I modified it to this, which does exactly what I need.

Sub New_Clear()

MSG1 = MsgBox("This action cannot be undone!" & vbCrLf & vbCrLf & "Selected Row is: " & ActiveCell.Row, 1, "CAUTION!")


    Application.ScreenUpdating = False
    
    If MSG1 = vbOK Then
    
        If Range("O" & ActiveCell.Row) <> "x" Then
            ActiveCell.EntireRow.Select
            Selection.Interior.Color = xlNone
            Selection.Font.Strikethrough = False
            Selection.Font.ColorIndex = 0
            Selection.ClearContents
        Else
    
        If Range("O" & ActiveCell.Row) = "x" Then
            Rows(ActiveCell.Row).Copy Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
            With Rows(ActiveCell.Row)
                .Interior.Color = xlNone
                .Font.Strikethrough = False
                .Font.ColorIndex = 0
                .ClearContents
            End With
        End If
        End If
    End If
    
    Application.ScreenUpdating = True
    
End Sub

I'm not very experienced at VBA so there is probably a more elegant way to do this with fewer lines of code.

Thanks again for the quick response time and for the code suggestion which did indeed solve my problem in an indirect way.

~ Phil

 

[mumps]

Maybe:

Sub New_Clear()
    Application.ScreenUpdating = False
    If MsgBox("This action cannot be undone!" & vbCrLf & vbCrLf & "The data in row " & ActiveCell.Row & " will be cleared. Are you sure?", vbYesNo) = vbYes Then
        If Range("O" & ActiveCell.Row) = "X" Then
            Rows(ActiveCell.Row).Copy Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
        With Rows(ActiveCell.Row)
            .Interior.Color = xlNone
            .Font.Strikethrough = False
            .Font.ColorIndex = 0
            .ClearContents
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[Philip1957]

Nope. No cigar.

It clears the designated row but fails to copy to the archive sheet when O = x for some reason even though the code to copy & past looks looks right to me

 

[mumps]

I tried the macro on some dummy data and it worked properly for me. It would be easier to help if you could post a screen shot of what your data looks like? Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[Philip1957]

mumps,

No disrespect intended and I truly appreciate your effort in assisting me, but since the code I have works, sloppy as it may be, I'm not going to put any more time into it.

I will be out on leave in less than 2 weeks and have other critical projects I need to close out before I go.

Thanks again for your help.

~ Phil

 

[mumps]

You are very welcome. In your case, the old saying: "If it's not broken, don't fix it." is very true.