Use vba to calculate birth

[NeewBie]

I want to calculate the age true date birth with VBA.
An example how the date birth is wrote: 196711141893 (the 4 last digits need to be splitted with “-“ so we got 19671114-1893). How to do that firstly true VBA?
After that I want it to calculate the age of the persons in range A:A.

Im looking for an VBA script and not an function.

Thank you!

 

[patel45]

Sub a()
LR = Cells(Rows.Count, "A").End(xlUp).Row
For r = 1 To LR
  d = Cells(r, 1).Text
  sd = Mid(d, 7, 2) & "/" & Mid(d, 5, 2) & "/" & Left(d, 4)
  age = Date - CDate(sd)
  Cells(r, 2) = age / 365
Next
End Sub

 

[davesweep]

Hi,

To add the hypen use this...

Delimited_Result = Left(Source, Len(Source) - 4) & "-" & Right(Source, 4)

to turn the date into an excel date, use this.....

Result_XLDate = DateSerial(Left(Delimited_Result, 4), Mid(Delimited_Result, 5, 2), Mid(Delimited_Result, 7, 2))

to determine age from this excel date use this.......

Calculated_age = Format(Now - result_XLDate, "yy/mm/dd")

NB result will be return in years/months/days

 

[NeewBie]

Sub a()
LR = Cells(Rows.Count, "A").End(xlUp).Row
For r = 1 To LR
  d = Cells(r, 1).Text
  sd = Mid(d, 7, 2) & "/" & Mid(d, 5, 2) & "/" & Left(d, 4)
  age = Date - CDate(sd)
  Cells(r, 2) = age / 365
Next
End Sub

Thank you so much! This script works GREAT!
I have a last question. How can I do for round down the result of the age?

 

[patel45]

Cells(r, 2) = int(age / 365)

 

[NeewBie]

Cells(r, 2) = int(age / 365)

This is so, so, so good! Last thing, If its concern column 4 or 6, how can I remake the script?

 

[NeewBie]

Cells(r, 2) = int(age / 365)

Sorry If I was unclear. I mean kg the Range are E:E or D:D, how can I remake the script?

 

[patel45]

Cells(r, 2) = int(age / 365)

2 is column B
3 is column C
4 is column D

 

[NeewBie]

Cells(r, 2) = int(age / 365)[/CODE]
2 is column B
3 is column C
4 is column D

Hmm... Now its not working, I need to remove all data from column 1-3 and Place the birthdate in column 1 so the script runs correctly.