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 SubHansVogelaar 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.
- HansVogelaarApr 02, 2024MVP
Are you sure you attached the correct workbook? There are no sample data or formulas...
- NarcAngelMar 30, 2024Copper Contributor
Sorry for the long delay for the reply, thank you again for all your help!
I was wondering something, this formula only works if I drag, I'm looking more toward a macro I think which would automatically calculate the age upon entering the DOB which it isn't doing right now. I'm looking at 500+ people which would not allow me to drag each time I would want to calculate the age.
One of the things I'm trying to see if it is possible is change font color to RED for any age entered that is 69 and less. So 70+ age would be normal black font and any age under 70 would be RED as to alert the viewer the person is not 70 years old + but I'm not really sure that is possible.- HansVogelaarMar 30, 2024MVP
Clear the Age column, and enter the formula
=IF([@[Date de Naissance]]="", "", DATEDIF([@[Date de Naissance]], TODAY(), "Y"))
in the first data row. It should automatically populate the entire column.
Select the Age column.
On the Home tab of the ribbon, click Conditional Formatting > New Rule...
Select 'Format only cells that contain'.
Leave the first drop down set to 'Cell Value'.
Select 'less than' from the second drop down.
In the box next to it, enter the formula=70
Click Format...
Activate the Font tab.
Select red as text color.
Click OK, then click OK again.See the attached demo workbook.