Forum Discussion
Looking for a macro for automatic sorting
Right-click the sheet tab.
Select View Code from the context menu.
Copy the code listed below into the worksheet module.
Switch back to Excel.
Save the workbook as a macro-enabled workbook.
Make sure that you allow macros when you open it.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim col As ListColumn
Dim rng As Range
Set tbl = Me.ListObjects(1)
Set col = tbl.ListColumns(1)
Set rng = col.DataBodyRange
If Not Intersect(rng, Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
With tbl.Sort
.SortFields.Clear
.SortFields.Add2 Key:=rng
.Header = xlYes
.Apply
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub- NarcAngelMar 24, 2024Copper Contributor
HansVogelaar That worked perfectly, any name I insert will go automatically in its order thank you!
Now I'm wondering, for birthday entry... is there a way to facilitate a macro or a format to enter the date?
Say I want to input all dates
01011945 (so 01 day, 01 month, 1945 year), I want only to be visible 01-Jan-45 (45 will be only visible but if you click on the cell you will see 1945) and after the birthday column I would like to set a macro for current age.
- HansVogelaarMar 24, 2024MVP
Set the number format of the birthday column to dd-mmm-yy.
Modify the code you already have as follows:
Private Sub Worksheet_Change(ByVal Target As Range) Dim tbl As ListObject Dim col As ListColumn Dim rng As Range Dim cel As Range Set tbl = Me.ListObjects(1) ' Use the real name of the birthday column Set col = tbl.ListColumns("Birthdate") Set rng = col.DataBodyRange If Not Intersect(rng, Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False On Error Resume Next For Each cel In Intersect(rng, Target) If Len(cel.Formula) = 8 Then cel.Value = DateSerial(Right(cel.Formula, 4), Mid(cel.Formula, 3, 2), Left(cel.Formula, 2)) ElseIf Len(cel.Formula) = 7 Then cel.Value = DateSerial(Right(cel.Formula, 4), Mid(cel.Formula, 2, 2), Left(cel.Formula, 1)) End If Next cel On Error GoTo 0 Application.EnableEvents = True Application.ScreenUpdating = True End If Set col = tbl.ListColumns(1) Set rng = col.DataBodyRange If Not Intersect(rng, Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False With tbl.Sort .SortFields.Clear .SortFields.Add2 Key:=rng .Header = xlYes .Apply End With Application.EnableEvents = True Application.ScreenUpdating = True End If End SubIn the next column, enter a formula like this:
=IF([@Birthdate]="", "", DATEDIF([@Birthdate], TODAY(), "Y"))
where Birthdate is the name of the birthday column. No macro needed for that.
- NarcAngelApr 02, 2024Copper Contributor
HansVogelaar I'm not sure I get where the error is, it is the same macro you've updated, I've resolved the issue with the +70 and -70, those works now but your demo you can enter DOB and it sets the Age correctly... mine.. just refuses. I'm uploading my sheet.