Calculate age

[Khan kashaf]

Hello pls help me .. I have 2 sheets source and output.. in source I have date of birth .. now I have to calculate age and print in output sheet through array ..

ActiveWorkbook.Sheets("Source").Select
Range("A1:D" & last).Value = arr
'2nd part

For i = LBound(arr, 1) To UBound(arr, 1)

    count = count + 1
    ReDim Preserve arr2(1 To last, 1 To 3)
    arr2(count, 1) = Trim(arr(i, 1))
    arr2(count, 2) = Trim(arr(i, 2))
 

    ActiveWorkbook.Sheets("Output").Select
Sheets("Output").Columns("A:C").AutoFit
Range("A1:C" & count).Value = arr2
Next
 ActiveWorkbook.Sheets("Source").Select
 
 For i = LBound(arr, 1) To UBound(arr, 1)
d1 = Day(Date)
d2 = Day(b)
m1 = Month(Date)
m2 = Month(b)
y1 = Year(Date)
y2 = Year(b)


If m1 > m2 Then
           d = y1 - y2
ElseIf (m1 >= m2 And d1 >= d2) Then
         d = y1 - y2
Else: d = y1 - y2


End If


Sheets("output").Range("C").Value = d & "year"
    count = count + 1
    ReDim Preserve arr2(1 To last, 1 To 3)
    arr2(count, 1) = Trim(arr(i, 1))
    arr2(count, 2) = Trim(arr(i, 2))
 Next

 

[Zyndstoff]

Your birthdate are liste in cells A1 through An, then:

Public Sub Age()
Dim myCell As Object, i As Integer
For Each myCell In Worksheets("source").Range("A1").CurrentRegion.Cells
i = i + 1
Worksheets("output").Cells(i, 1) = CInt(Application.WorksheetFunction.YearFrac(CDate(myCell), CDate(Now)))
Next myCell
End Sub

 

[Khan kashaf]

Your birthdate are liste in cells A1 through An, then:

Public Sub Age()
Dim myCell As Object, i As Integer
For Each myCell In Worksheets("source").Range("A1").CurrentRegion.Cells
i = i + 1
Worksheets("output").Cells(i, 1) = CInt(Application.WorksheetFunction.YearFrac(CDate(myCell), CDate(Now)))
Next myCell
End Sub

Public Sub Age()
Dim myCell As Object, i As Integer
For Each myCell In Worksheets("source").Range("A1").CurrentRegion.Cells
i = i + 1
Worksheets("output").Cells(i, 1) = CInt(Application.WorksheetFunction.YearFrac(CDate(myCell), CDate(Now)))
Next myCell
End Sub. I have to this way but it shows error pls help me it is important to me very much

 

[Khan kashaf]

I am trying but it doesn't work


Sub fetch()
Dim b As Date

Dim arr()
Dim arr3()
Dim arr2()
Dim s
Dim len1 As Integer
Dim Lastrow
Dim count As Integer
Dim path, mainPath
Dim wb As Workbook
Dim i As Integer

path = ThisWorkbook.path
mainPath = path & "\Main.xlsx"
Set wb = Workbooks.Open(mainPath)
last = Range("A1").End(xlDown).Row
arr = Range("A1:D" & last)

wb.Close

ActiveWorkbook.Sheets("Source").Select
Range("A1:D" & last).Value = arr
'2nd part

For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 3) <> "" Then
arr(i, 3) = Format(Now() - arr(i, 3).Value, "YY")
count = count + 1
ReDim Preserve arr2(1 To last, 1 To 3)
arr2(count, 1) = Trim(arr(i, 1))
arr2(count, 2) = Trim(arr(i, 2))
arr2(count, 3) = Trim(arr(i, 3))
End If

ActiveWorkbook.Sheets("Output").Select
Sheets("Output").Columns("A:C").AutoFit
Range("A1:C" & count).Value = arr2
Next

 

[Zyndstoff]

I don't understand what you need all that code for...?

My code that I posted will
1. read the birthdates from sheet "source", cells A1 through An
2. determine the current age
3. write the age to cells A1 through An in sheet "output"

That is what you wanted, right?

 

[Khan kashaf]

Yes

Your birthdate are liste in cells A1 through An, then:

Public Sub Age()
Dim myCell As Object, i As Integer
For Each myCell In Worksheets("source").Range("A1").CurrentRegion.Cells
i = i + 1
Worksheets("output").Cells(i, 1) = CInt(Application.WorksheetFunction.YearFrac(CDate(myCell), CDate(Now)))
Next myCell
End Sub

But I have to do it through array as I have other data too .. see where I am now
Sub fetch()
Dim arr()
Dim arr2()
last = Worksheets("source").Range("A1").End(xlDown).Row
arr = Range("A1:D" & last)
ActiveWorkbook.Sheets("Source").Select
Range("A1:D" & last).Value = arr
'2nd part

For i = LBound(arr, 1) To UBound(arr, 1)
Count = Count + 1
ReDim Preserve arr2(1 To last, 1 To 3)
arr2(Count, 1) = Trim(arr(i, 1))
arr2(Count, 2) = Trim(arr(i, 2))
If arr2(i, 3) <> "" Then
arr(i, 3) = Format(Now() - arr(i, 3).Value, "YY")
arr2(Count, 3) = Trim(arr(i, 3))


ActiveWorkbook.Sheets("Output").Select
Sheets("Output").Columns("A:C").AutoFit
Range("A1:C" & Count).Value = arr2
End If
Next
Please help me

 

[Zyndstoff]

Public Sub Age()
Dim myCell As Object, i As Integer, arr() As Integer
For Each myCell In Worksheets("source").Range("A1").CurrentRegion.Cells
i = i + 1
ReDim arr(i)
arr(i) = CInt(Application.WorksheetFunction.YearFrac(CDate(myCell), CDate(Now)))
Worksheets("output").Cells(i, 1) = arr(i) & " Years"
Next myCell
End Sub


The age will be stored in arr(i) as integers, the ouput will go to cells A1 to Ai in sheet "output"