Convert Function from Access2000 to Access97

  • Thread starter Thread starter Dale
  • Start date Start date
D

Dale

Hi everyone, I have a function to calculate percentiles that was built in
Access 2000, which I would like to use in my Access 97 applications. I have
converted the formula (or so I think), but the result does not calculate
properly. My guess is, variables for reuse are not stored properly, it keeps
repeating the one value for each row (24 rows):
Site N Mean Min Max p_10 p_25 p_50 p_75 p_90
9 1418 2.86 1.02 27.07 1.02 1.02 1.02 1.02 1.02
10 4481 3.03 0.62 26.07 0.62 0.62 0.62 0.62 0.62


ALL that I have changed is how the recordset is accessed:

Dim sqlSort As String
'Static cnn As ADODB.Connection
Static db As Database
Dim rst As Recordset

..........more code between

'Set cnn = CurrentProject.Connection
'Set rst = cnn.Execute(sqlSort)
Set db = CurrentDb
Set rst = db.OpenRecordset(sqlSort, dbOpenDynaset)

Is the Static declaration not being used correctly?...any help is
appreciated...Thanks
All references are set to dao and not to ado..thanks again
 
Thanks Ken
I tried "Dim db as Database" but the values are duplicated for each
calculated field as previous.
I guess I should mention the code works as a domain function in A2000..in
A97 it doesn't seem to be calculating the percentile field, rather just
replicating the min value. Guess I might just have to submit to A2000!
 
Here is the code in its entirety...since I thought the issue was with how
the recordset was opened...didn't think the code would be needed...In case
anyone thought I was the author (I wish)...in recognition of the author Tom
Dierickx

Function is accessed through a query:
p_10: DPercentile(10,"fldname","tblname","[optional]=" & [optional])

Public Function DPercentile(p As Double, Expr As String, Domain As String,
Optional Criteria As String) As Double

On Error GoTo ErrHandler:

'VERIFY VALID PERCENTILE (0-100) WAS GIVEN
If (p <= 0 Or p >= 100) Then
DPercentile = -555555555 'Something to stick out!
Exit Function
End If

'DECLARE VARIABLES
Dim sqlSort As String
'Static cnn As ADODB.Connection
Dim db As Database
Dim rst As Recordset
Dim Data 'as dynamic array
Dim N As Long
Dim break_pt As Double
Dim low_obs As Long, high_obs As Long
Dim r1 As Double, r2 As Double
Dim x1 As Double, x2 As Double
Dim x As Double

'ENSURE DESIRED DATA IS SORTED
sqlSort = "SELECT " & Expr & " " & _
"FROM " & Domain & " " & _
"WHERE " & Expr & " IS NOT NULL "

If Len(Criteria) > 0 Then sqlSort = sqlSort & "AND " & Criteria
sqlSort = sqlSort & " ORDER BY " & Expr & ""


'QUERY CURRENT DATABASE FOR DESIRED DATA AND RETURN BACK INTO AN ARRAY
Set db = CurrentDb()
Set rst = db.OpenRecordset(sqlSort)
If rst.EOF Then Exit Function
Data = rst.GetRows()
Set db = Nothing

'HOW MANY OBSERVATONS? FOR EXAMPLE, N=12
N = UBound(Data, 2) + 1

'WHICH OBSERVATION WOULD, THEORETICALLY, BE THE pTH "TRUE" PERCENTILE.
'e.g., FOR 25TH PERCENTILE WOULD BE THE 0.25*(12+1)=3.25TH OBSERVATION
break_pt = (p / 100) * (N + 1) '3.25 = (25/100)*(12+1)

'THERE'S 2 SPECIAL EXTREME CASES WE NEED TO WORRY ABOUT!
If break_pt <= 1 Then break_pt = 1 'small sample for small
Percentile
If break_pt >= N Then break_pt = N 'small sample for large
Percentile

'BUT SINCE THERE'S NO SUCH THING AS A 3.25TH OBSERVATION, WE INTERPOLATE
IT TO BE
'SOMEWHERE BETWEEN THE 3RD AND 4TH OBSERVATIONS. THUS, IT'LL BE
APPROXIMATELY:
'p = r1*low_obs + r2*high_obs
low_obs = Int(break_pt) '3 = int(3.25)
high_obs = low_obs + 1 '4 = 3 + 1

'NOW, WE HAVE TO INTERPOLATE BETWEEN THE 2 "BOUNDARIES"
r1 = high_obs - break_pt '0.75 = 4 - 3.25
r2 = 1 - r1 '0.25 = 1 - 0.75

'PULL LOW VALUE FROM (ZERO-BASED) DATA ARRAY
x1 = Data(0, low_obs - 1)

'PULL HIGH VALUE FROM (ZERO-BASED) DATA ARRAY
If (r2 > 0) Then
x2 = Data(0, high_obs - 1)
Else
x2 = 0
End If

'COMBINE "MIDDLE" OBSERVATIONS, WEIGHTED ACCORDINGLY TO WHICH ONE YOU'RE
CLOSER TO
x = r1 * x1 + r2 * x2

'WE NOW HAVE OUR PERCENTILE!
DPercentile = x
Exit Function

ErrHandler:
DPercentile = -555555555

End Function
 
Hi Dale,

I can't see the point of
Static db As DAO.Database
because as Help says each call to
Set db = CurrentDB()
"returns an object variable of type Database that represents the
database currently open in the Microsoft Access window."

Probably it would be better to do
Dim db As DAO.Database
...
Set db = DBEngine(0)(0)

Have you stepped through your code to identify just where it's going
wrong?
 
The code will not work if the real field name that you'd put in place of
[optional] in the fourth argument is a text-formatted field. Such fields
require the criterion value to be delimited by ' characters for the WHERE
filter to work in an SQL string.

In other words, if you wanted to use a field of MyField in the fourth
argument, you'd do this, right?
"[MyField]=" & [MyField]

However, if MyField is a text field, the correct expression would be this:
"[MyField]='" & [MyField] & "'"

By chance, is this what is happening in your database?

--

Ken Snell
<MS ACCESS MVP>



Dale said:
Here is the code in its entirety...since I thought the issue was with how
the recordset was opened...didn't think the code would be needed...In case
anyone thought I was the author (I wish)...in recognition of the author Tom
Dierickx

Function is accessed through a query:
p_10: DPercentile(10,"fldname","tblname","[optional]=" & [optional])

Public Function DPercentile(p As Double, Expr As String, Domain As String,
Optional Criteria As String) As Double

On Error GoTo ErrHandler:

'VERIFY VALID PERCENTILE (0-100) WAS GIVEN
If (p <= 0 Or p >= 100) Then
DPercentile = -555555555 'Something to stick out!
Exit Function
End If

'DECLARE VARIABLES
Dim sqlSort As String
'Static cnn As ADODB.Connection
Dim db As Database
Dim rst As Recordset
Dim Data 'as dynamic array
Dim N As Long
Dim break_pt As Double
Dim low_obs As Long, high_obs As Long
Dim r1 As Double, r2 As Double
Dim x1 As Double, x2 As Double
Dim x As Double

'ENSURE DESIRED DATA IS SORTED
sqlSort = "SELECT " & Expr & " " & _
"FROM " & Domain & " " & _
"WHERE " & Expr & " IS NOT NULL "

If Len(Criteria) > 0 Then sqlSort = sqlSort & "AND " & Criteria
sqlSort = sqlSort & " ORDER BY " & Expr & ""


'QUERY CURRENT DATABASE FOR DESIRED DATA AND RETURN BACK INTO AN ARRAY
Set db = CurrentDb()
Set rst = db.OpenRecordset(sqlSort)
If rst.EOF Then Exit Function
Data = rst.GetRows()
Set db = Nothing

'HOW MANY OBSERVATONS? FOR EXAMPLE, N=12
N = UBound(Data, 2) + 1

'WHICH OBSERVATION WOULD, THEORETICALLY, BE THE pTH "TRUE" PERCENTILE.
'e.g., FOR 25TH PERCENTILE WOULD BE THE 0.25*(12+1)=3.25TH OBSERVATION
break_pt = (p / 100) * (N + 1) '3.25 = (25/100)*(12+1)

'THERE'S 2 SPECIAL EXTREME CASES WE NEED TO WORRY ABOUT!
If break_pt <= 1 Then break_pt = 1 'small sample for small
Percentile
If break_pt >= N Then break_pt = N 'small sample for large
Percentile

'BUT SINCE THERE'S NO SUCH THING AS A 3.25TH OBSERVATION, WE INTERPOLATE
IT TO BE
'SOMEWHERE BETWEEN THE 3RD AND 4TH OBSERVATIONS. THUS, IT'LL BE
APPROXIMATELY:
'p = r1*low_obs + r2*high_obs
low_obs = Int(break_pt) '3 = int(3.25)
high_obs = low_obs + 1 '4 = 3 + 1

'NOW, WE HAVE TO INTERPOLATE BETWEEN THE 2 "BOUNDARIES"
r1 = high_obs - break_pt '0.75 = 4 - 3.25
r2 = 1 - r1 '0.25 = 1 - 0.75

'PULL LOW VALUE FROM (ZERO-BASED) DATA ARRAY
x1 = Data(0, low_obs - 1)

'PULL HIGH VALUE FROM (ZERO-BASED) DATA ARRAY
If (r2 > 0) Then
x2 = Data(0, high_obs - 1)
Else
x2 = 0
End If

'COMBINE "MIDDLE" OBSERVATIONS, WEIGHTED ACCORDINGLY TO WHICH ONE YOU'RE
CLOSER TO
x = r1 * x1 + r2 * x2

'WE NOW HAVE OUR PERCENTILE!
DPercentile = x
Exit Function

ErrHandler:
DPercentile = -555555555

End Function
Click to expand...
 
As far as I know, you can't simply use Data = rst.GetRows(): you must pass
the number of rows you want as an argument to the function.

The Access 97 Help file has the following in its example:

' Open dynaset-type Recordset object.
Set rst = dbs.OpenRecordset(strSQL)
' Move to end of recordset.
rst.MoveLast
' Return to first record.

rst.MoveFirst
' Return all rows into array.
varRecords = rst.GetRows(rst.RecordCount)


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)



Dale said:
Here is the code in its entirety...since I thought the issue was with how
the recordset was opened...didn't think the code would be needed...In case
anyone thought I was the author (I wish)...in recognition of the author Tom
Dierickx

Function is accessed through a query:
p_10: DPercentile(10,"fldname","tblname","[optional]=" & [optional])

Public Function DPercentile(p As Double, Expr As String, Domain As String,
Optional Criteria As String) As Double

On Error GoTo ErrHandler:

'VERIFY VALID PERCENTILE (0-100) WAS GIVEN
If (p <= 0 Or p >= 100) Then
DPercentile = -555555555 'Something to stick out!
Exit Function
End If

'DECLARE VARIABLES
Dim sqlSort As String
'Static cnn As ADODB.Connection
Dim db As Database
Dim rst As Recordset
Dim Data 'as dynamic array
Dim N As Long
Dim break_pt As Double
Dim low_obs As Long, high_obs As Long
Dim r1 As Double, r2 As Double
Dim x1 As Double, x2 As Double
Dim x As Double

'ENSURE DESIRED DATA IS SORTED
sqlSort = "SELECT " & Expr & " " & _
"FROM " & Domain & " " & _
"WHERE " & Expr & " IS NOT NULL "

If Len(Criteria) > 0 Then sqlSort = sqlSort & "AND " & Criteria
sqlSort = sqlSort & " ORDER BY " & Expr & ""


'QUERY CURRENT DATABASE FOR DESIRED DATA AND RETURN BACK INTO AN ARRAY
Set db = CurrentDb()
Set rst = db.OpenRecordset(sqlSort)
If rst.EOF Then Exit Function
Data = rst.GetRows()
Set db = Nothing

'HOW MANY OBSERVATONS? FOR EXAMPLE, N=12
N = UBound(Data, 2) + 1

'WHICH OBSERVATION WOULD, THEORETICALLY, BE THE pTH "TRUE" PERCENTILE.
'e.g., FOR 25TH PERCENTILE WOULD BE THE 0.25*(12+1)=3.25TH OBSERVATION
break_pt = (p / 100) * (N + 1) '3.25 = (25/100)*(12+1)

'THERE'S 2 SPECIAL EXTREME CASES WE NEED TO WORRY ABOUT!
If break_pt <= 1 Then break_pt = 1 'small sample for small
Percentile
If break_pt >= N Then break_pt = N 'small sample for large
Percentile

'BUT SINCE THERE'S NO SUCH THING AS A 3.25TH OBSERVATION, WE INTERPOLATE
IT TO BE
'SOMEWHERE BETWEEN THE 3RD AND 4TH OBSERVATIONS. THUS, IT'LL BE
APPROXIMATELY:
'p = r1*low_obs + r2*high_obs
low_obs = Int(break_pt) '3 = int(3.25)
high_obs = low_obs + 1 '4 = 3 + 1

'NOW, WE HAVE TO INTERPOLATE BETWEEN THE 2 "BOUNDARIES"
r1 = high_obs - break_pt '0.75 = 4 - 3.25
r2 = 1 - r1 '0.25 = 1 - 0.75

'PULL LOW VALUE FROM (ZERO-BASED) DATA ARRAY
x1 = Data(0, low_obs - 1)

'PULL HIGH VALUE FROM (ZERO-BASED) DATA ARRAY
If (r2 > 0) Then
x2 = Data(0, high_obs - 1)
Else
x2 = 0
End If

'COMBINE "MIDDLE" OBSERVATIONS, WEIGHTED ACCORDINGLY TO WHICH ONE YOU'RE
CLOSER TO
x = r1 * x1 + r2 * x2

'WE NOW HAVE OUR PERCENTILE!
DPercentile = x
Exit Function

ErrHandler:
DPercentile = -555555555

End Function
Click to expand...
 
Not having stepped through the code completely I can't in fairness comment on it.

HOWEVER, I think the problem is likely to be that SQL has been optimized to call
the code only one time (at least in Access97) if no value in the parameters
change. It sees that nothing has changed so there is no need to call the code again.

Can you post the SQL where you call the function?

You might be able to modify the function to make it be called for every row or
perhaps you could modify the call to include in the optional criteria something like
" FieldA = 20 AND Len(FieldA) = " & Len(FieldA)

This would cause the function to be called for each row, since Len(FieldA) has
to be determined for each row.

AND, of course, I could be completely mistaken. But, first step, post at least
the portion of the SQL that is calling the function.

Here is the code in its entirety...since I thought the issue was with how
the recordset was opened...didn't think the code would be needed...In case
anyone thought I was the author (I wish)...in recognition of the author Tom
Dierickx

Function is accessed through a query:
p_10: DPercentile(10,"fldname","tblname","[optional]=" & [optional])

Public Function DPercentile(p As Double, Expr As String, Domain As String,
Optional Criteria As String) As Double

On Error GoTo ErrHandler:

'VERIFY VALID PERCENTILE (0-100) WAS GIVEN
If (p <= 0 Or p >= 100) Then
DPercentile = -555555555 'Something to stick out!
Exit Function
End If

'DECLARE VARIABLES
Dim sqlSort As String
'Static cnn As ADODB.Connection
Dim db As Database
Dim rst As Recordset
Dim Data 'as dynamic array
Dim N As Long
Dim break_pt As Double
Dim low_obs As Long, high_obs As Long
Dim r1 As Double, r2 As Double
Dim x1 As Double, x2 As Double
Dim x As Double

'ENSURE DESIRED DATA IS SORTED
sqlSort = "SELECT " & Expr & " " & _
"FROM " & Domain & " " & _
"WHERE " & Expr & " IS NOT NULL "

If Len(Criteria) > 0 Then sqlSort = sqlSort & "AND " & Criteria
sqlSort = sqlSort & " ORDER BY " & Expr & ""

'QUERY CURRENT DATABASE FOR DESIRED DATA AND RETURN BACK INTO AN ARRAY
Set db = CurrentDb()
Set rst = db.OpenRecordset(sqlSort)
If rst.EOF Then Exit Function
Data = rst.GetRows()
Set db = Nothing

'HOW MANY OBSERVATONS? FOR EXAMPLE, N=12
N = UBound(Data, 2) + 1

'WHICH OBSERVATION WOULD, THEORETICALLY, BE THE pTH "TRUE" PERCENTILE.
'e.g., FOR 25TH PERCENTILE WOULD BE THE 0.25*(12+1)=3.25TH OBSERVATION
break_pt = (p / 100) * (N + 1) '3.25 = (25/100)*(12+1)

'THERE'S 2 SPECIAL EXTREME CASES WE NEED TO WORRY ABOUT!
If break_pt <= 1 Then break_pt = 1 'small sample for small
Percentile
If break_pt >= N Then break_pt = N 'small sample for large
Percentile

'BUT SINCE THERE'S NO SUCH THING AS A 3.25TH OBSERVATION, WE INTERPOLATE
IT TO BE
'SOMEWHERE BETWEEN THE 3RD AND 4TH OBSERVATIONS. THUS, IT'LL BE
APPROXIMATELY:
'p = r1*low_obs + r2*high_obs
low_obs = Int(break_pt) '3 = int(3.25)
high_obs = low_obs + 1 '4 = 3 + 1

'NOW, WE HAVE TO INTERPOLATE BETWEEN THE 2 "BOUNDARIES"
r1 = high_obs - break_pt '0.75 = 4 - 3.25
r2 = 1 - r1 '0.25 = 1 - 0.75

'PULL LOW VALUE FROM (ZERO-BASED) DATA ARRAY
x1 = Data(0, low_obs - 1)

'PULL HIGH VALUE FROM (ZERO-BASED) DATA ARRAY
If (r2 > 0) Then
x2 = Data(0, high_obs - 1)
Else
x2 = 0
End If

'COMBINE "MIDDLE" OBSERVATIONS, WEIGHTED ACCORDINGLY TO WHICH ONE YOU'RE
CLOSER TO
x = r1 * x1 + r2 * x2

'WE NOW HAVE OUR PERCENTILE!
DPercentile = x
Exit Function

ErrHandler:
DPercentile = -555555555

End Function
Click to expand...
 
Thank you all for your help, Douglas Steele's suggestion
worked!!...Yeahhhh...I can stay with my A97 Apps!
Thanks again, you are all wonderful ... and have gotten me out of many a
pickle!
 
Back
Top