Copy row to another sheet with a twist

[Danick]

I have a 4 column spreadsheet called “Current” that is tracking items that need to be done before an expiration date. I also have an identical spreadsheet called “Completed” which is used to view when items were completed.

The 4 columns are
Item, Renewal period (Yrs), Expiration date, Completed date

What I would like to have happen is, after the competed date is filled in, I would like to be able to press a button that will copy that row and append it to the “Completed” sheet. And then modify the info in the “Current” sheet by deleting the completed date and updating the expiration date based on the renewal period (ie New Expiration date = Expiration date + Renewal Period).
I have seen plenty of examples of moving data from one sheet to another, but never one that will also modify the original row. Not sure if this can be done with one button click.

Any help would be appreciated.

 

[CJ_London]

do what may people do - start recording a macro to do what you want and when finished, edit the code for use in a button. That at least will give you the structure for your process.

 

[Danick]

Well I did that but now it just continues to move the same row.
How can I change this so that it is relative to the row I'm trying to move?
I'm not too concerned about the button, maybe it can be triggered after updating the cell in column "F". (Starting on row 2 since row 1 are the headers. )

Sub MoveCompleted()
'
' MoveCompleted Macro
'

'
    Range("A8:F8").Select
    Selection.Copy
    Sheets("Completed").Select
    Range("A8").Select
    ActiveSheet.Paste
    Sheets("Current").Select
    Range("H8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F8").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub

 

[arnelgp]

supposed that your sheet starts in column A:

Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim s As String
'select the active cell
Sheets("Current").Activate
s = ActiveCell.Address
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 4)).Select
'copy
Application.Selection.Copy

'active completed sheet
Sheets("Completed").Activate
Set sh = ActiveSheet
Dim lngRow As Long
'find the last row
lngRow = fnLastRow(sh) + 1
'select last row
sh.Range("A" & lngRow).Select
'paste
Application.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
'go back to current sheet
Set sh = Sheets("current")
sh.Activate
sh.Range(s).Select
lngRow = ActiveCell.Row
' clear the selection
sh.Range("D" & lngRow).Select
Selection.ClearContents

' update expiration date
sh.Range("C" & lngRow).Value = DateAdd("y", sh.Range("B" & lngRow).Value, sh.Range("C" & lngRow).Value)
End Sub

paste this in a new Module:

Function fnLastRow(sh As Worksheet) As Long
    On Error Resume Next
    fnLastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

make sure that you are at the right row (cell) where you want to copy before hitting your command button.

 

[Danick]

Awesome first shot at it.
All is good except the last part to update the expiration date.
I am using a column "G" of that row which has a formula to calculate the next expiration date. So all that is needed is to copy the value in column "G" and paste the values in Column "D".

I modiied your code to work with my spreadsheet

Private Sub CommandButton1_Click()

Dim sh As Worksheet
Dim s As String
'select the active cell
Sheets("Current").Activate
s = ActiveCell.Address
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 6)).Select
'copy
Application.Selection.Copy

'active completed sheet
Sheets("Completed").Activate
Set sh = ActiveSheet
Dim lngRow As Long
'find the last row
lngRow = fnLastRow(sh) + 1
'select last row
sh.Range("A" & lngRow).Select
'paste
Application.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
'go back to current sheet
Set sh = Sheets("current")
sh.Activate
sh.Range(s).Select
lngRow = ActiveCell.Row
' clear the selection
sh.Range("F" & lngRow).Select
Selection.ClearContents

' update expiration date
'sh.Range("C" & lngRow).Value = DateAdd("y", sh.Range("B" & lngRow).Value, sh.Range("C" & lngRow).Value)
sh.Range("G" & lngRow).Select
Selection.Copy
sh.Range("D" & lngRow).Select
Application.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Only one other item that maybe you could help me with, in order to not allow it to update by accident, would it be possible to modify the code to first check if cell "F" has something in it?

 

[Danick]

Only one other item that maybe you could help me with, in order to not allow it to update by accident, would it be possible to modify the code to first check if cell "F" has something in it?

Never mind - I just figured it out by adding a small if statement to the start of the Sub. This seems to work but wouldn't mind if you'd take a look at it to see if there may be a problem doing it this way or if there is a better way of doing it.

' check if Competed before running macro
If Sheets("Current").Range("F" & (ActiveCell.Row)) = "" Then
MsgBox "No completion Date - Update Canceled"
Exit Sub
End If

 

[arnelgp]

you've done it just fine.