Solved: VBA function in a field

[philfer]

Hello,

I have created a function in a VBA module which I am using in a field.

i.e. the function accepts a date as an argument and returns a time bucket.

The field expression takes a date value from the underlying data and returns a time bucket (i.e. between 6 and 12 months).

However if I try to use this field in a totals query or use it in a crosstab Access slows right down and it takes ages to run the query

Is this normal?

Is there a way to make it work much quicker

Thanks
Phil

[orange]

Please show us the function and the query.

[philfer]

Hello,

The Function goes something like this :-

Function DateInterval(dtMyDate As Date) As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim dtCalcDate As Date


Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCalcDate")

dtCalcDate = rst![DateValue]

If dtMyDate = #1/1/2000# Then '1/1/2000 is a default value if there is no date
DateInterval = "Open ended"
ElseIf Not dtMyDate <= DateAdd("m", 3, dtCalcDate) And dtMyDate <> #1/1/2000# Then
DateInterval = "< 3Months"
ElseIf dtMyDate > DateAdd("m", 3, dtCalcDate) And dtMyDate <= DateAdd("m", 3, dtCalcDate) Then
DateInterval = ">3Months <=6Months"
ElseIf dtMyDate > DateAdd("m", 6, dtCalcDate) And dtMyDate <= DateAdd("m", 12, dtCalcDate) Then
DateInterval = ">6Months <=1Year"
ElseIf dtMyDate > DateAdd("m", 12, dtCalcDate) And dtMyDate <= DateAdd("m", 24, dtCalcDate) Then
DateInterval = ">1Year <=2Years"
ElseIf dtMyDate > DateAdd("m", 24, dtCalcDate) And dtMyDate <= DateAdd("m", 60, dtCalcDate) Then
DateInterval = ">1Year <=2Years"
ElseIf dtMyDate > DateAdd("m", 60, dtCalcDate) Then
DateInterval = ">5Years"
Else
DateInterval = "Error"
End If

rst.Close
dbs.Close

Set rst = Nothing
Set dbs = Nothing

End Function



In the field I have :-

Interval : TimeInterval([tblDate]![EndDate])


I then use this field as the column value in the crosstab

Thanks
Phil

[orange]

Hello,

The Function goes something like this :-

Function DateInterval(dtMyDate As Date) As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim dtCalcDate As Date


Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCalcDate")

dtCalcDate = rst![DateValue]

If dtMyDate = #1/1/2000# Then '1/1/2000 is a default value if there is no date
DateInterval = "Open ended"
ElseIf Not dtMyDate <= DateAdd("m", 3, dtCalcDate) And dtMyDate <> #1/1/2000# Then
DateInterval = "< 3Months"
ElseIf dtMyDate > DateAdd("m", 3, dtCalcDate) And dtMyDate <= DateAdd("m", 3, dtCalcDate) Then
DateInterval = ">3Months <=6Months"
ElseIf dtMyDate > DateAdd("m", 6, dtCalcDate) And dtMyDate <= DateAdd("m", 12, dtCalcDate) Then
DateInterval = ">6Months <=1Year"
ElseIf dtMyDate > DateAdd("m", 12, dtCalcDate) And dtMyDate <= DateAdd("m", 24, dtCalcDate) Then
DateInterval = ">1Year <=2Years"
ElseIf dtMyDate > DateAdd("m", 24, dtCalcDate) And dtMyDate <= DateAdd("m", 60, dtCalcDate) Then
DateInterval = ">1Year <=2Years"
ElseIf dtMyDate > DateAdd("m", 60, dtCalcDate) Then
DateInterval = ">5Years"
Else
DateInterval = "Error"
End If

rst.Close
dbs.Close

Set rst = Nothing
Set dbs = Nothing

End Function



In the field I have :-

Interval :


I then use this field as the column value in the crosstab

Thanks
Phil

Hmmm.. I'm not following.
You have a function called DateInterval that accepts a date as an argument and returns a time bucket?

Could you please elaborate on "time bucket"? A brief description that identifies the purpose of the function. I see you are comparing dates-- but I don't know what values are in your tables.

When you call the function , you say TimeInterval([tblDate]![EndDate]),
but the function is DateInterval????

[philfer]

Sorry that was a typo.....I call the function as DateInterval

The time buckets are time intervals :-

open ended
<3months
>3months<=6months
>6months<=1year
>1year<=2years
>2years<=5years
>5 years

The raw data has :-


Account Amount Expiry Date
12345 100 1/2/2010
23456 500 3/5/2012
34567 250 9/12/2011
45678 6000 8/6/2015
98764 1000 5/12/2013

The table CalcDate only has one field which is the current date the calculation/analysis is being run for i.e. 31/12/2009

Cheers
Phil

[philfer]

Oh yeah and I want to end up with :-

Account number open ended <3Months >3Months<=6Months etc

123456 100
23456 500
4567698

etc


Thanks

[orange]

Sorry that was a typo.....I call the function as DateInterval

The time buckets are time intervals :-

open ended
<3months
>3months<=6months
>6months<=1year
>1year<=2years
>2years<=5years
>5 years

The raw data has :-


Account Amount Expiry Date
12345 100 1/2/2010
23456 500 3/5/2012
34567 250 9/12/2011
45678 6000 8/6/2015
98764 1000 5/12/2013

The table CalcDate only has one field which is the current date the calculation/analysis is being run for i.e. 31/12/2009

Cheers
Phil


I'm having trouble here Phil. You show some sample/raw data, then you talk of table calcDate which has only 1 field?

What exactly does the raw data represent? Which table?
How exactly are you calling your function, to get the results you want?

Can you give a sample function call, using your 31/12/2009?

[philfer]

The CalcDate table is used in the Function. The function gets the DateValue from this table which will be 31/12/2009 in this case and compares it to the value passed and then returns the appropriate time interval.

The query selects all the fields from the raw data called tblData (i.e. the account, the amount and the expiry date (i.e. 1/2/2010). I then add an extra field which is an expression :-

Interval : DateInterval([tblData]![Expiry Date])

So my query would look like :-

Account Amount Expiry Date Interval
12345 100 1/2/2010 <3months
etc


I then try to create a crosstab using the above query as its source. The crosstab has Account as its rows, Amount as its Values and Interval as its columns :-


Account Open Ended <3Months >3Months<=6Months
12345 100



But when I run the crosstab it is very very slow

[orange]

The CalcDate table is used in the Function. The function gets the DateValue from this table which will be 31/12/2009 in this case and compares it to the value passed and then returns the appropriate time interval.

The query selects all the fields from the raw data called tblData (i.e. the account, the amount and the expiry date (i.e. 1/2/2010). I then add an extra field which is an expression :-

Interval : DateInterval([tblData]![Expiry Date])

So my query would look like :-

Account Amount Expiry Date Interval
12345 100 1/2/2010 <3months
etc


I then try to create a crosstab using the above query as its source. The crosstab has Account as its rows, Amount as its Values and Interval as its columns :-


Account Open Ended <3Months >3Months<=6Months
12345 100



But when I run the crosstab it is very very slow

I just tried your function using Expiry Date = 1/2/2010
with a dtCalcDate of 31/12/2009 and got Error returned

I had to remove the NOT from

ElseIf Not dtMyDate <= DateAdd("m", 3, dtCalcDate) And dtMyDate <> #1/1/2000
to get the <3 months

[OBP]

See my response to your previous Thread on Crosstab Queries using the Quarter function.

[orange]

See my response to your previous Thread on Crosstab Queries using the Quarter function.

I haven't seen OBP previous response, but you can certainly modify your function, such as, -- just for a sample

Function dd(dExpiryDt As Date, dCalcDt As Date) As String

Select Case DateDiff("m", dCalcDt, dExpiryDt)
Case 1, 2, 3
dd = "<3 Months"
Case 4 to 6
dd = ">3 Months < 6 months"
Case 7 to 12
dd = ">6Months < 1 year"
Case 13 To 24
dd = ">1 year <2 years"
Case 25 To 60
dd = ">2 year <5years"
Case Is > 60
dd = ">than 5 years"
Case 0
dd = "error"
Case Else
dd = "Error"
End Select
End Function

[orange]

Is the attached jpg (crosstab output) what you're looking for?

Routine to populate the 'Timebucket' field on table "philfer"

'---------------------------------------------------------------------------------------
' Procedure : philfertest
' Author : Jack
' Created : 1/16/2010
' Purpose : To populate a field (timebucket) on a table (pHilfer) with a text string.
' Using the table of string expressions provided by Phil Hilfer(VBAX).
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: N/A
' Calls: Function dd
'------------------------------------------------------------------------------
'
Sub philfertest()
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error GoTo philfertest_Error

Set db = CurrentDb
Set rs = db.OpenRecordset("philfer")
Dim CalcDate As Date
CalcDate = #12/31/2009#
Do While Not rs.EOF
rs.Edit
rs!timebucket = dd(rs![ExpiryDate], CalcDate)
Debug.Print rs!timebucket
rs.Update
rs.MoveNext
Loop
On Error GoTo 0
Exit Sub

philfertest_Error:

MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure philfertest of Module Module4"

End Sub
Fuction DD

'---------------------------------------------------------------------------------------
' Procedure : dd
' Author : Jack
' Created : 1/16/2010
' Purpose : To determine the number of months between a CalcDate and an ExpiryDate
' and then using Case statement assign and return a string expression.
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: dExpiryDt As Date, dCalcDt As Date
' Outputs: a string
' Dependency: N/A
'------------------------------------------------------------------------------
'
Function dd(dExpiryDt As Date, dCalcDt As Date) As String

On Error GoTo dd_Error

Select Case DateDiff("m", dCalcDt, dExpiryDt)
Case 1, 2, 3
dd = "<3 Months"
Case 4, 5, 6
dd = ">3 Months < 6 months"
Case 7, 8, 9, 10, 11, 12
dd = ">6Months < 1 year"
Case 13 To 24
dd = ">1 year <2 years"
Case 25 To 60
dd = ">2 year <5years"
Case Is > 60
dd = ">than 5 years"
Case 0
dd = "error"
Case Else
dd = "Error"
End Select

On Error GoTo 0
Exit Function

dd_Error:

MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure dd of Module Module4"
End Function
Crosstab code

TRANSFORM pHilfer.amount
SELECT pHilfer.expiryDate, pHilfer.account, Count(pHilfer.account) AS [Total Of account], pHilfer.amount
FROM pHilfer
GROUP BY pHilfer.expiryDate, pHilfer.account, pHilfer.amount
PIVOT pHilfer.timebucket;


Only a few records so I can't comment on speed based on my test. Don't see why it should be slow.