VBA to Move row to bottom in table depending on cell value

[SarahMS1]

hello i’m new at work and i need help with a very easy task but i dont know how to do it with tables just with ranges in VBA, but its important to keep it as a table to my boss, what i need is a row goes to the bottom depending on the cell value on column O when it says “ DONE” and i prefer not with modules cause i dont want to run macro each time vba on the sheet code

 

[DanteAmor]

Hi and welcome to MrExcel!
some details.
Do you have formulas in the table?
Do you have empty rows in the table?
What is the name of the table?
What is the name of the field in column O?

 

[SarahMS1]

no formulas, no empty row but every-time we get a new status we inserting row so its an active sheet everyday it expands and the status of the row changes, the name is table2 the column name is Status

 

[SarahMS1]

Hi and welcome to MrExcel!
some details.
Do you have formulas in the table?
Do you have empty rows in the table?
What is the name of the table?
What is the name of the field in column O?

no formulas, no empty row but every-time we get a new status we inserting row so its an active sheet everyday it expands and the status of the row changes, the name is table2 the column name is Status

 

[DanteAmor]

Put the following code in the events of your sheet.

Each time write the word "DONE" in the status column of the "Table2" table, the row will move to the end of the table.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tbl As ListObject, wRow As Long
  Set tbl = ActiveSheet.ListObjects("Table2")
  If Target.CountLarge > 1 Then Exit Sub
  If Not Intersect(Target, tbl.ListColumns("Status").Range) Is Nothing Then
    If UCase(Target.Value) = "DONE" Then
      Application.ScreenUpdating = False
      wRow = Target.Row - tbl.HeaderRowRange.Row
      tbl.ListRows.Add AlwaysInsert:=True
      tbl.DataBodyRange.Rows(wRow).Copy tbl.DataBodyRange.Rows(tbl.ListRows.Count)
      tbl.ListRows(wRow).Delete
    End If
  End If
End Sub

 

[SarahMS1]

t

Put the following code in the events of your sheet.

Each time write the word "DONE" in the status column of the "Table2" table, the row will move to the end of the table.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tbl As ListObject, wRow As Long
  Set tbl = ActiveSheet.ListObjects("Table2")
  If Target.CountLarge > 1 Then Exit Sub
  If Not Intersect(Target, tbl.ListColumns("Status").Range) Is Nothing Then
    If UCase(Target.Value) = "DONE" Then
      Application.ScreenUpdating = False
      wRow = Target.Row - tbl.HeaderRowRange.Row
      tbl.ListRows.Add AlwaysInsert:=True
      tbl.DataBodyRange.Rows(wRow).Copy tbl.DataBodyRange.Rows(tbl.ListRows.Count)
      tbl.ListRows(wRow).Delete
    End If
  End If
End Sub

THANK YOU it worked!!!! ur a lifesaver!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[Ninjee]

Put the following code in the events of your sheet.

Each time write the word "DONE" in the status column of the "Table2" table, the row will move to the end of the table.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tbl As ListObject, wRow As Long
  Set tbl = ActiveSheet.ListObjects("Table2")
  If Target.CountLarge > 1 Then Exit Sub
  If Not Intersect(Target, tbl.ListColumns("Status").Range) Is Nothing Then
    If UCase(Target.Value) = "DONE" Then
      Application.ScreenUpdating = False
      wRow = Target.Row - tbl.HeaderRowRange.Row
      tbl.ListRows.Add AlwaysInsert:=True
      tbl.DataBodyRange.Rows(wRow).Copy tbl.DataBodyRange.Rows(tbl.ListRows.Count)
      tbl.ListRows(wRow).Delete
    End If
  End If
End Sub

Hello, I have a same situation.
Bur this code does not work on mine. Can you help me, please
Thank you in advance