move a row when a specific value is entered and add date and user stamp.

[DMO123]

Hi All,

so i have probably a common question but i cannot figure it out.

I am trying to move a whole row based on what is entered in column F. so if i enter "Yes" in column F the whole row should move to Sheet6 finding the next available line in the table.

i have the code below that moves the row to the sheet i need and finds the next available line but it does not go in to the table for some reason? also want to add a date stamp of the move and a user stamp. the date stamp should show in column N and the username stamp should show in column O

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Intersect(Target, Columns("F:F")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    If Target.Value = "Yes" Then
        Target.EntireRow.Copy Sheet6.Range("A" & Rows.Count).End(3)(2)
        Target.EntireRow.Delete
    End If
    
    Sheet6.Columns.AutoFit
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

​

 

[mumps]

When you say "Table" are you referring to an actual Excel table which would have a name such as "Table1" or "Table2" or are you referring to a regular Excel range?

 

[DMO123]

sorry for not clarifying it is "Table1" "Table2" etc.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Intersect(Target, Columns("F:F")) Is Nothing Then Exit Sub
    Dim bottomA As Long
    bottomA = Sheet6.Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).End(xlUp).Offset(1).Row
    Application.ScreenUpdating = False
    If Target.Value = "Yes" Then
        Target.EntireRow.Copy Sheet6.Cells(bottomA, 1)
    End If
    Sheet6.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[DMO123]

@mumps thanks it moves the row but no date stamp and user stamp. also if i wanted to change it to cut the row would i be correct with the below?

"Target.EntireRow.Copy Sheet6.Cells(bottomA, 1)" to"Target.EntireRow.Cut Sheet6.Cells(bottomA, 1)"


Thanks!

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Intersect(Target, Columns("F:F")) Is Nothing Then Exit Sub
    Dim bottomA As Long
    bottomA = Sheet6.Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).End(xlUp).Offset(1).Row
    Application.ScreenUpdating = False
    If Target.Value = "Yes" Then
        Target.EntireRow.Copy Sheet6.Cells(bottomA, 1)
        Sheet6.Range("O" & bottomA) = Now
        Sheet6.Range("P" & bottomA) = Application.UserName
        Target.EntireRow.Delete
    End If
    Sheet6.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

If you use "Cut", you will be left with a blank row. The above macro should do what you want.

 

[DMO123]

@mumps thank you! this is working - the only issue is it does not sit inside the table on sheet6 (not sure why)?

 

[mumps]

What do you mean by:

does not sit inside the table

 

[DMO123]

so the table (table6) starts on row 3 (with row 1 & 2 as a header). when i use the code it pastes the row on line 4 not 3 where the next empty row is? so it is placing outside the table.

so you have something like the below

Header (row 1)
header (row2)
Blank row of the table (row 3)
information gets pasted (row 4)

 

[mumps]

Working with tables is a little different than working with normal Excel ranges. If the table starts at row 3, Excel recognizes row 3 as the header row of the table. This means that the first available row would be row 4. I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps 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. If the workbook contains confidential information, you could replace it with generic data.