Looking for a formula or VBA code that will return the age in the same cell where I had input the birthdate

milt2010

Board Regular
Joined
Dec 18, 2010
Messages
118
Hello to all,
as I wrote in the title, I would like to enter a birth date in a cell and get the corresponding age back in the same cell, after I press return or another key.

Thanks in advance for any help
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Hi,

You can use the following code:


Code:
Private Sub Worksheet_Change(ByVal Target As Range)


    If Not Intersect(Target, Me.Range("[COLOR=#ff0000]A1:A10[/COLOR]")) Is Nothing Then
        Application.EnableEvents = False
            With Target
                If IsDate(.Text) And .Cells.Count = 1 Then
                    .Value = DateDiff("yyyy", .Value, Date)
                    .NumberFormat = "@"
                End If
            End With
        Application.EnableEvents = True
    End If


End Sub

Open your VBA window (Alt+F11), double-click on a sheet where you want this Change Event to be triggered, and paste this code there.
You can also change a Target range from A1:A10 to any range where you want this code to work.

Let me know if this is what you were looking for.
 
Upvote 0
Yes, that's exactly what I was looking for! Thank you very much!
 
Last edited:
Upvote 0
Hello again! I entered the code in a worksheet where there are also other codes and initially it worked perfectly. Then, I do not know why, it started not working anymore. The bug message I receive is: Runtime error 1004: Unebla to set the number of the property of the range class "with the error that appears in the image I attached.
Any idea? https://1drv.ms/f/s!AtkvD-EXoGv6jpAdDlWzfeHNyqvU8g
 
Upvote 0
You need to show us all the code you have in this sheet.
The script worked for me.

And I never click on links or open files.
Do not say: Just open or look at my link. If you want help from me
 
Upvote 0
The code works fine for me.
But, you can only have 1 worksheet code in a Sheet Module....so you might need to combine codes.
 
Upvote 0
You need to show us all the code you have in this sheet.
The script worked for me.

And I never click on links or open files.
Do not say: Just open or look at my link. If you want help from me
Thank you and ok, My Aswer Is This, but I can't to attach the worksheet, sorry... I can only post the all code in the worksheet.

Thank you too Michael M. Yes, it 's true, even to me it works well alone. But when I insert it along with the other codes it stops working.

This is the all code(s) in the Worksheet:
Code:
'''''''''''''''''
'BIRTHDATE CODE '
'''''''''''''''''
Private Sub Worksheet_Change(ByVal Target As Range)


    If Not Intersect(Target, Me.Range("J1:J300")) Is Nothing Then
        Application.EnableEvents = False
            With Target
                If IsDate(.Text) And .Cells.Count = 1 Then
                    .Value = DateDiff("yyyy", .Value, Date)
                   [COLOR=#00ff00].NumberFormat = "@"[/COLOR] ''here is the problem ("Runtime error 1004: Unable to set the number  of the property of the range class")
                End If
            End With
        Application.EnableEvents = True
    End If
''''''''''''''''''''''''''''''
'"if" CODE AUTONUMBER COLOUMN'
''''''''''''''''''''''''''''''
If Intersect(Target, Range("E5:E300,M5:M300,D5:T300")) Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Application.Calculation = xlManual
If Target.Column = 5 Then
Dim i As Long
Range("D5:D300").ClearContents
For i = 5 To Cells(Rows.Count, 5).End(xlUp).Row
Cells(i, 4).FormulaR1C1 = "=IF(RC[1]="""","""",SUBTOTAL(3,R5C5:RC[1]))"
Next i
End If
If Target.Column = 11 Then
'Dim i As Long
Dim b As Integer
Dim c As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For Each c In Range("K5:K300")
For b = 1 To Lastrow
If c.Value = Cells(b, 1).Value Then c.Value = Cells(b, 2).Value
Next
Next
End If
''''''''''''''''''''''''''
'Autofit + UpperCase CODE'
''''''''''''''''''''''''''
If Target.Column >= 4 And Target.Column <= 12 Then
If Target.Cells.Count > 1 Or Target.HasFormula Then ''interpretazione da controllare
Application.Calculation = xlAutomatic
Calculate
Application.EnableEvents = True
Exit Sub
End If
Target = UCase(Target)
Sheets("List").Columns("D:T").AutoFit
End If
Application.Calculation = xlAutomatic
Calculate
Application.EnableEvents = True
End Sub
'''''''''''''''''''
'HYPERLINK CODE   '
'''''''''''''''''''
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 14 Then Exit Sub
Dim rngFound As Range
    With Worksheets("Respons.").Columns(5) 'Guarda in quale colonna cercare
         Set rngFound = .Find(Target.Offset(0, -6).Value, LookIn:=xlValues,  LookAt:=xlWhole, After:=.Cells(1), Searchdirection:=xlNext)
        If Not rngFound Is Nothing Then
            Application.Goto rngFound(1, Target.Value + 1)
        Else
            MsgBox "There were not matches found for " & Target(1, -5).Value
        End If
    End With
Cancel = True
End Sub
 
Last edited:
Upvote 0
Post your worksheet to DropBox then post the link back here.

The worksheet isn't protected is it ???
 
Upvote 0
Ok, I'll post it on the dropbox. Normally I would like it to be protected (always via VBA code) but I post it without protection ...
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top