Calculate Age

[miben]

I have a function that calculates the age of someone. The problem is that I am using a database with about 6000 records and each record goes through this process and really slows down the record retrieving process. Is there any way I can speed this process up? I thought about using a statement in SQL, but I havn't found anything yet.
Thanks

Public Sub RetrieveDebtors(ClientId as String)
Dim lstItem as ListItem
Dim intItem as Integer
Dim intCount as Integer

'Retrieves the count of records to be accessed
Set recDebtors = dbsData.OpenRecordset("SELECT COUNT(*)" & _
" AS intCount FROM Debtors WHERE ClientId = '" & _
ClientId & "'")
intCount = recDebtors!intCount

'Retrieves the records
Set recDebtors = dbsData.OpenRecordset("SELECT * FROM " & _
Debtors WHERE ClientId= '" & strDebtorId & _
"' ORDER BY DebtorId DESC")

'Adds the items to the list
For intItem = 1 To intCount
Set lstItem = vewNotes.ListItems.Add()
With lstItem
.SmallIcon = 1
.Key = recDebtors!Id
.Text = FullName(recDebtors!First, recDebtors!Last)
.SubItems(1) = recDebtors!Birthdate
.SubItems(2) = Age(recdebtor!Birthdate)
End With
recNotes.MoveNext
Next
End Sub()

Private Function Age(ByVal strBirth As Date) As Integer
Dim intYear As Integer
Dim strCurrent As String
Dim datBirth As Date

datBirth = CDate(strBirth)
If datBirth <= Date Then 'Date selected is less
'than current date
strCurrent = Format(Date, "mm/dd")
strBirth = Format(strBirth, "mm/dd")
intYear = Year(Date) - Year(cboBirthday)

'Determines is month and day of birth has exceeded
'the current month and day
If strCurrent < strBirth Then
'Current month and day has not reached the
'birth month and day
intYear = intYear - 1
End If

Else 'Date selected is greater than current date
MsgBox "The birthdate selected is greater " & _
"than the current date.", vbInformation, "Birthdate"
intYear = 0
End If

Age = intYear 'Returns the age
End Function

[Jop]

Use this code from Wayne to calculate a person's age, I think it's easier to see

'[begin of code]
'Author: Wayne
'Origin:
'Purpose: Calculate a persons age
'Version: VB5+

Option Explicit

Public Function GetAge(DateString As String) As Integer
       Dim lDate As Date
       lDate = Left$(DateString, 2) + "/" + Mid$(DateString, 3, 2) _
       + "/" + Right$(DateString, 4)
       GetAge = DateDiff("yyyy", lDate, Now)
End Function

'Usage
Private Sub Command1_Click()
'use your birthday in this format mmddyyyy
    Dim x As String    'this is your birthday var
    x = 12301970       'value
    MsgBox GetAge(x)   'call function
End Sub
'[end of code]

And to speed things up, don't add them to a list, but to an Array

Any particular reason you can't calculate the age in the select SQL?

sql = "SELECT *,int((Now() - Debtors!Birthdate)/365.25) as AGE" _
sql = sql & " FROM Debtors"
sql = sql & " WHERE ClientId= '" & strDebtorId & _
"' ORDER BY DebtorId DESC"


Set recDebtors = dbsData.OpenRecordset(sql)

I'm not sure about the exact syntax, but I've done similar things in the past.


Good Luck
DerFarm

[miben]

I tried to use that, but that code doesn't calculate the correct age all of the time. For example, if todays date is 6/22/2000:

datBirth = #6/23/1998#
intYear = DateDiff("yyyy", datBirth, Now)

Retruns 2, but...

datBirth = #6/21/1998#
intYear = DateDiff("yyyy", datBirth, Now)

Also returns 2, but should return 1 because the date has not been reached yet.
There needs to be a seperate statement to determine if that date has been reach such as:

strBirth = Format(strBirth, "mm/dd")
strCurrent = Format(#6/22/2000#, "mm/dd")
If strCurrent < strBirth Then
   'Current month and day has not reached the
   'birth month and day
   intYear = intYear - 1 'Take the year away
End If

This code will give you the correct age to the month and day

Yeah, the int function will round on you. Thus if xxx/yyy = z.q where q >=.5 you'll get int(xxx/yyy) = Z+1...Not what I like but there it is.

Try using trunc() instead, that just cuts off the decimals.


Good Luck
DerFarm

[miben]

I created a complicated SQL statement that works!

Dim intCount as Integer
Dim lstItem as ListItem
Dim intItem as Integer

Set recDebtors = dbsData.OpenRecordset("SELECT " & _
    "COUNT(*) AS intCount"
intCount = recDebtors!intCount

Set recDebtors = dbsData.OpenRecordset("SELECT *, " & _
    "DateDiff('yyyy',[Birthday],Date())-[intPassed] " & _
    "AS intAge, Int(Format([Birthday],'mm/dd')<" & _
    "Format(Date()+1,'mm/dd'))+1 AS intPassed FROM Debtors")

'Adds the items to the list 
For intItem = 1 To intCount 
    Set lstItem = vewNotes.ListItems.Add() 
    With lstItem 
        .SmallIcon = 1 
        .Key = recDebtors!Id 
        .Text = FullName(recDebtors!First, recDebtors!Last) 
        .SubItems(1) = recDebtors!Birthday
        .SubItems(2) = "Age: " & intAge
    End With 
    recDebtors.MoveNext 
Next

This code returns:
1) All debtor information
2) Debtor's age, intAge
3) If the month and day has passed, intPassed
4) The count of records accessed, intCount

This makes my code extremely faster! And it automatically takes away 1 if intPassed = True.

If anyone can find a way to combine those 2 SQL statement and return the same results, great!