Move Entire Row To The Bottom Of Active Table Based On non blank Cell

[Jd2023]

Hi all,

I would like to automatically move an entire row to the bottom of the table when column 'AD' is populated with a date? I have this code which is not working?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lr As Long
Dim r As Long

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

' Exit it cell updated not on column AD
If Target.Column <> 30 Then Exit Sub

' See if date entered in column
If IsDate(Target) And Target > 0 Then
Application.EnableEvents = False
' Find last row with data in column D
lr = Cells(Rows.Count, "D").End(xlUp).Row
' Move row to bottom of sheet
r = Target.Row
Rows(r).Cut
Cells(lr + 1, "A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Delete old row
Rows(r).Delete
Application.EnableEvents = True
End If

End Sub

In addition, I would also like to automatically group rows together when a name is populated in column A?

I would appreciate any help with this.

Kind Regards
Jasmine

 

[LazyBug]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, r As Long
Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
    ' See if date entered in column
    If IsDate(Target) Then
        ' Find last row with data in column D
        lr = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
        ' Move row to bottom of sheet
        r = Target.Row
        ActiveSheet.Rows(r).Copy ActiveSheet.Rows(lr + 1)
        ActiveSheet.Rows(r).Delete
'        Application.CutCopyMode = False
    End If
Application.EnableEvents = True
End Sub

 

[Jd2023]

Thank you LazyBug, however this is still not working?

 

[LazyBug]

Oh, my bad.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, r As Long
Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("AD:AD")) Is Nothing Then Exit Sub
    ' See if date entered in column
    If IsDate(Target) Then
        ' Find last row with data in column D
        lr = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
        ' Move row to bottom of sheet
        r = Target.Row
        ActiveSheet.Rows(r).Copy ActiveSheet.Rows(lr + 1)
        ActiveSheet.Rows(r).Delete
'        Application.CutCopyMode = False
    End If
Application.EnableEvents = True
End Sub