Moving a row automatically in an excel table

[shylar1]

Good afternoon,

I've read a few other posts looking to do this, but not quite sure what I need to change in the code to get it to work for me.

I'd like to see if someone is willing to help with code for column D (Status) = "Dropped", move row to the bottom of the table.

I already have the conditional formatting set to grey the row out if this isn't a possibility, but moving the row would be *much* better.

Thank you!

 

[shylar1]

i've got it moving to the bottom of the sheet. is there a way to change that to bottom of active table?

 

[shylar1]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Long

If Target.CountLarge > 1 Then Exit Sub

' See if cell just updated is in column D, if not exit sub
If Target.Column <> 4 Then Exit Sub

' See if cell just updated set to "Dropped"
If Target.Value = "Dropped" Then
r = Target.Row
' Move to end
Application.EnableEvents = False
Rows(r).Cut
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Rows(r).Delete
Application.EnableEvents = True
End If

End Sub

is what i took from a different thread - but again, hoping to get it to end of table instead of sheet.

 

[Alex Blakenburg]

See if this fixes it:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Long
    
    If Target.CountLarge > 1 Then Exit Sub
    
    ' See if cell just updated is in column D, if not exit sub
    If Target.Column <> 4 Then Exit Sub
    
    ' See if cell just updated set to "Dropped"
    If Target.Value = "Dropped" Then
        r = Target.Row
        ' Move to end
        Application.EnableEvents = False
        Rows(r).Cut
        Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Insert Shift:=xlDown
        Application.EnableEvents = True
    End If

End Sub

 

[shylar1]

that gave an error message when trying to execute.

i changed it up to this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim tbl As ListObject
Dim r As Long

' Exit if more than one cell updated
If Target.CountLarge > 1 Then Exit Sub

' Exit if updated cell not in E2:E44
If Intersect(Range("D2:D69"), Target) Is Nothing Then Exit Sub

' See if value set to "Dropped"
If Target.Value = "Dropped" Then
Application.EnableEvents = False
' Get updated row
r = Target.Row
' Set table name
Set ws = ActiveSheet
Set tbl = ws.ListObjects("Table1")
' Add new row
tbl.ListRows.Add
' Copy data down
Range(Cells(r, "A"), Cells(r, "S")).Cut
Range("A71").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Delete blank rows
Rows(r).Delete
Application.EnableEvents = True
End If

End Sub

Which works for now... but if i could get it to auto figure out the end of the table range, that'd be ideal. Some months won't have 70 and i'd love to not have to edit the code every new sheet i setup

 

[NoSparks]

This would copy the data as values, is it of any use?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim tbl As ListObject
    Dim newRow As ListRow
    Dim r As Long

' Exit if more than one cell updated
If Target.CountLarge > 1 Then Exit Sub

' Set what table
Set tbl = ActiveSheet.ListObjects("Table1")

' Check for updated cell in "Status" listcolumn
If Not Intersect(Target, tbl.ListColumns("Status").DataBodyRange) Is Nothing Then
    ' See if value set to "Dropped"
    If Target.Value = "Dropped" Then
        Application.EnableEvents = False
        With tbl
            ' Get listrow of target
            r = Target.Row - .HeaderRowRange.Row
            ' Add new table row
            Set newRow = .ListRows.Add
            newRow.Range.Value = .ListRows(r).Range.Value
            .ListRows(r).Delete
        End With
        Application.EnableEvents = True
    End If
End If

End Sub

 

[Alex Blakenburg]

Please use the code tags when posting your code. I find the VBA button to be the easiest.

If the code provided NoSparks doesn't work then:
1) What was the error message (maybe a picture) when you ran my code ?
2) what line of code was highlighted when you clicked the debug button ?
3) do you have data to the right and/or below the table ?
4) does your table have empty rows in it ?
5) what is your tablename ?
6) maybe a picture of your Table headings which includes the column and row references ?