Auto sort after date stamp

[HDavidson]

I am using the Vba code below to apply a date stamp in a spreadsheet .How can i adapt this to auto sort all the data with newest entry at the top.The spreadsheet covers the columns A to J inclusive

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 1 Then Cells(Target.Row, "j") = Now()
End Sub

Thanks

 

[James006]

Hello,

You can insert the following

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Count > 1 Then Exit Sub
   Dim last As Long
   last = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row
   Application.ScreenUpdating = False
   If Target.Row > 1 Then Cells(Target.Row,"J") = Now()
   Range("A1:J" & last).Sort [J1], xlAscending, Header:=xlYes
   Range("J1").Select
   Application.ScreenUpdating = True
End Sub

Hope this will help

 

[HDavidson]

Thanks james that returns the runtime error below

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Count > 1 Then Exit Sub
   Dim last As Long
   last = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row
   Application.ScreenUpdating = False
   If Target.Row > 1 Then Cells(Target.Row, "J") = Now()
   Range("A1:J" & last).Sort [J1], xlAscending, Header:=xlYes Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Count > 1 Then Exit Sub
   Dim last As Long
   last = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row
   Application.ScreenUpdating = False
   If Target.Row > 1 Then Cells(Target.Row, "J") = Now()
   Range("A1:J" & last).Sort [J1], xlAscending, Header:=xlYes
   Range("J1").Select
   Application.ScreenUpdating = True
End Sub

Thanks for looking 
   Range("J1").Select
   Application.ScreenUpdating = True
End Sub

 

[HDavidson]

Thanks for looking james i get a runtime error when this is run .The debug indicates the error is in line 7

Range("A1:J" & last).Sort [J1], xlAscending, Header:=xlYes

Thanks again

 

[James006]

Re,

The spreadsheet covers the columns A to J inclusive

Does it mean you have headers in Row 1 ...and you data starting in Row 2 ...???

 

[HDavidson]

yes headers are in row 1 data to sort starts in row 2.

Thanks

 

[James006]

Hello,

Can you make sure within the module of your Sheet ... to delete the previous version and replace it with exactly the following

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Count > 1 Then Exit Sub
   Dim last As Long
   last = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   If Target.Row > 1 Then Cells(Target.Row, "J") = Now()
   Application.ScreenUpdating = True
   Range("A1:J" & last).Sort [J1], xlAscending, Header:=xlYes
   Application.EnableEvents = True
End Sub

To be on the safe side ... just tested this event macro ...
and it does work fine ...

Hope this will help

 

[HDavidson]

Hi James the now function wont change the time if i enter data into column 2 and wait 1 min and change it again so the last row edited does not move to the top of the list. Sorry to be a pain.


Thanks

 

[HDavidson]

All sorted James i am a happy boy now.

Thanks

 

[James006]

Glad you could fix your problem ...

Believe the issue was related to Ascending vs Descending ... :wink: