Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Aggregate Functions 2
- Thread starter PaulCoop
- Start date
-
1
- #2
Hi Paul!
I think you would need to pass the table name also, here are some ideas:
Public Function DConcat(MyField As String, MyTable As String, MyCriteria As String, Delim As String) As String
Dim sql As String
Dim rst As DAO.Recordset
Dim intCounter As Long
Dim ReturnString As String
sql = "Select " & MyField & " From " & MyTable
If MyCriteria <> "" Then
sql = sql & " Where " & MyCriteria
End If
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rst.EOF = True And rst.BOF = True Then
DConcat = ""
Else
rst.MoveLast
rst.MoveFirst
ReturnString = ""
For intCounter = 0 To rst.RecordCount
If intCounter <> rst.RecordCount Then
ReturnString = ReturnString & rst.Fields(MyField) & Delim
Else
DConcat = ReturnString & rst.Fields(MyField)
Next intCounter
End If
End Function
Public Function Mode(MyField As String, MyTable As String, MyCriteria As String) As Variant
Dim sql As String
Dim rst As DAO.Recordset
Dim Value() As Variant
Dim ValueCount() As Integer
Dim intRecordNumber As Integer
Dim intCounter As Integer
Dim bolFound As Boolean
Dim intReturnValue As Integer
sql = "Select " & MyField & " From " & MyTable
If MyCriteria <> "" Then
sql = sql & " Where " & MyCriteria
End If
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rst.EOF = True And rst.BOF = True Then
Mode = ""
Else
rst.MoveFirst
intRecordNumber = 1
ReDim Value(1 to 1)
ReDim ValueCount(1 to 1)
Do Until rst.EOF = True
If intRecordNumber = 1 Then
Value(1) = rst.Fields(MyField)
ValueCount(1) = 1
intRecordNumber = 2
Else
For intCounter = 1 To intRecordNumber - 1
If Value(intCounter) = rst.Fields(MyField) Then
ValueCount(intCounter) = ValueCount(intCounter) + 1
bolFound = True
Exit For
End If
Next intCounter
If bolFound = True Then
bolFound = False
Else
ReDim Preserve Value(1 to intRecordNumber)
ReDim Preserve ValueCount(1 to intRecordNumber)
Value(intRecordNumber) = rst.Fields(MyField)
ValueCount(intRecordNumber) = 1
intRecordNumber = intRecordNumber + 1
End If
End If
rst.MoveNext
Loop
intRecordNumber = intRecordNumber - 1
End If
intReturnValue = 1
If intRecordNumber = 1 Then
Mode = Value(1)
Else
For intCounter = 2 to intRecordNumber
If ValueCount(intCounter) > ValueCount(intReturnValue) Then
intReturnValue = intCounter
Next intCounter
Mode = Value(intReturnValue)
End If
End Function
Public Function Median(MyField As String, MyTable As String, MyCriteria As String) As Variant
Dim sql As String
Dim rst As DAO.Recordset
Dim intMiddle As Integer
sql = "Select " & MyField & " From " & MyTable
If MyCriteria <> "" Then
sql = sql & " Where " & MyCriteria
End If
sql = sql & " Order By " & MyField
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rst.EOF = True And rst.BOF = True Then
Median = ""
Else
rst.MoveLast
intMiddle = rst.RecordCount\2
Median = rst.Fields(MyField)
End If
End Function
I imagine improvements can be made on these because I haven't tested any of them. Also I forgot to set rst = Nothing in any of them. At least it should give you a place to start.
hth
Jeff Bridgham
bridgham@purdue.edu
I think you would need to pass the table name also, here are some ideas:
Public Function DConcat(MyField As String, MyTable As String, MyCriteria As String, Delim As String) As String
Dim sql As String
Dim rst As DAO.Recordset
Dim intCounter As Long
Dim ReturnString As String
sql = "Select " & MyField & " From " & MyTable
If MyCriteria <> "" Then
sql = sql & " Where " & MyCriteria
End If
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rst.EOF = True And rst.BOF = True Then
DConcat = ""
Else
rst.MoveLast
rst.MoveFirst
ReturnString = ""
For intCounter = 0 To rst.RecordCount
If intCounter <> rst.RecordCount Then
ReturnString = ReturnString & rst.Fields(MyField) & Delim
Else
DConcat = ReturnString & rst.Fields(MyField)
Next intCounter
End If
End Function
Public Function Mode(MyField As String, MyTable As String, MyCriteria As String) As Variant
Dim sql As String
Dim rst As DAO.Recordset
Dim Value() As Variant
Dim ValueCount() As Integer
Dim intRecordNumber As Integer
Dim intCounter As Integer
Dim bolFound As Boolean
Dim intReturnValue As Integer
sql = "Select " & MyField & " From " & MyTable
If MyCriteria <> "" Then
sql = sql & " Where " & MyCriteria
End If
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rst.EOF = True And rst.BOF = True Then
Mode = ""
Else
rst.MoveFirst
intRecordNumber = 1
ReDim Value(1 to 1)
ReDim ValueCount(1 to 1)
Do Until rst.EOF = True
If intRecordNumber = 1 Then
Value(1) = rst.Fields(MyField)
ValueCount(1) = 1
intRecordNumber = 2
Else
For intCounter = 1 To intRecordNumber - 1
If Value(intCounter) = rst.Fields(MyField) Then
ValueCount(intCounter) = ValueCount(intCounter) + 1
bolFound = True
Exit For
End If
Next intCounter
If bolFound = True Then
bolFound = False
Else
ReDim Preserve Value(1 to intRecordNumber)
ReDim Preserve ValueCount(1 to intRecordNumber)
Value(intRecordNumber) = rst.Fields(MyField)
ValueCount(intRecordNumber) = 1
intRecordNumber = intRecordNumber + 1
End If
End If
rst.MoveNext
Loop
intRecordNumber = intRecordNumber - 1
End If
intReturnValue = 1
If intRecordNumber = 1 Then
Mode = Value(1)
Else
For intCounter = 2 to intRecordNumber
If ValueCount(intCounter) > ValueCount(intReturnValue) Then
intReturnValue = intCounter
Next intCounter
Mode = Value(intReturnValue)
End If
End Function
Public Function Median(MyField As String, MyTable As String, MyCriteria As String) As Variant
Dim sql As String
Dim rst As DAO.Recordset
Dim intMiddle As Integer
sql = "Select " & MyField & " From " & MyTable
If MyCriteria <> "" Then
sql = sql & " Where " & MyCriteria
End If
sql = sql & " Order By " & MyField
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rst.EOF = True And rst.BOF = True Then
Median = ""
Else
rst.MoveLast
intMiddle = rst.RecordCount\2
Median = rst.Fields(MyField)
End If
End Function
I imagine improvements can be made on these because I haven't tested any of them. Also I forgot to set rst = Nothing in any of them. At least it should give you a place to start.
hth
Jeff Bridgham
bridgham@purdue.edu
Paul,
If I understood your question, you wanted to write one that 'links' to the sql engine to run the same way as Sum,First, etc? The answer to that would be no, the sql engine is compiled and set in stone, so jebrys would be the path to take.
Even 'hand-written' functions that would mimmick Dlookup, for example, usually won't run as fast because these internal functions are compiled in the dll and will naturally have less overhead than a p-code function written by a user, unless you put such a handwritten in your own dll and referenced it.
--Jim
If I understood your question, you wanted to write one that 'links' to the sql engine to run the same way as Sum,First, etc? The answer to that would be no, the sql engine is compiled and set in stone, so jebrys would be the path to take.
Even 'hand-written' functions that would mimmick Dlookup, for example, usually won't run as fast because these internal functions are compiled in the dll and will naturally have less overhead than a p-code function written by a user, unless you put such a handwritten in your own dll and referenced it.
--Jim
Hi!
Found an oops in one function and a better way in another. First the oops:
In the Median function the Else statement should be
If rst.EOF = True And rst.BOF = True Then
Median = ""
Else
rst.MoveLast
rst.MoveFirst
For intMiddle = 1 To rst.RecordCount\2
rst.MoveNext
Next intMiddle
Median = rst.Fields(MyField)
End If
And now the better way in the Mode Function:
sql = "Select & MyField & ", Count(" & MyField & "
As FieldCount From " & MyTable & " Group By " & MyField
* check for criteria and open recordset*
If rst.EOF = True And rst.BOF = True Then
Mode = ""
Else
rst.MoveFirst
intCount = rst!FieldCount
varField = rst.Fields(MyField)
rst.MoveNext
Do Until rst.EOF = True
If rst!FieldCount > intCount Then
intCount = rst!FieldCount
varField = rst.Fields(MyField)
End if
rst.MoveNext
Loop
Mode = varField
End If
I think those are better.
Jeff Bridgham
bridgham@purdue.edu
Found an oops in one function and a better way in another. First the oops:
In the Median function the Else statement should be
If rst.EOF = True And rst.BOF = True Then
Median = ""
Else
rst.MoveLast
rst.MoveFirst
For intMiddle = 1 To rst.RecordCount\2
rst.MoveNext
Next intMiddle
Median = rst.Fields(MyField)
End If
And now the better way in the Mode Function:
sql = "Select & MyField & ", Count(" & MyField & "
As FieldCount From " & MyTable & " Group By " & MyField* check for criteria and open recordset*
If rst.EOF = True And rst.BOF = True Then
Mode = ""
Else
rst.MoveFirst
intCount = rst!FieldCount
varField = rst.Fields(MyField)
rst.MoveNext
Do Until rst.EOF = True
If rst!FieldCount > intCount Then
intCount = rst!FieldCount
varField = rst.Fields(MyField)
End if
rst.MoveNext
Loop
Mode = varField
End If
I think those are better.
Jeff Bridgham
bridgham@purdue.edu
Guest_imported
New member
- Jan 1, 1970
- 0
Thanks for the code Jeff it will save me the effort of starting from stratch.
Jim you were right in recognising that I was meaning SQL aggregates (maybe I should of been a tad clearer, Jeff). It was really wishful thinking that made me ask the question in the first place as I have done similar stuff before by looping thorough a Recordset in code. It is a pity that Microsoft hasn't spotted the usefulness of such functions. (Unless any of these have been introduced in AccessXP of which I know nothing.)
Paul Cooper
Jim you were right in recognising that I was meaning SQL aggregates (maybe I should of been a tad clearer, Jeff). It was really wishful thinking that made me ask the question in the first place as I have done similar stuff before by looping thorough a Recordset in code. It is a pity that Microsoft hasn't spotted the usefulness of such functions. (Unless any of these have been introduced in AccessXP of which I know nothing.)
Paul Cooper
-
1
- #7
MichaelRed
Programmer
Hmmmmmmmmm,
The functions all exist in the excel library, which may be added to Ms. Access (Menu: Tools==>References). Rather than re-inventing (including all that messy debugging), it is just a matter of propper use.
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
The functions all exist in the excel library, which may be added to Ms. Access (Menu: Tools==>References). Rather than re-inventing (including all that messy debugging), it is just a matter of propper use.
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
MichaelRed
Programmer
? indigenious? - I don't think so -but they CAN be used where VBA functions are used. In some instances, the db engine does not recognize even VBA functions, so there are no 'guarntees', but I have used many of the Excel functions in Ms. Access and in VB, with some uses in both 'languages' including db/tables. Where it gets 'sticky' is where the Excel functions expect a range (e.g. A1:A21) reference. Mostly, this is just an array, but on some dunctions it apprars to either want the array passes by ref or I'm not understanding the call properly. As far as I know, the statstical package all use arg lists, so should be amenable to use by adding the reference. The only problem I am aware of w/ this approach is in distribuiting an app where the licensing issue(s) may be obscure and the ver/location of the libraries can be questionable as well.
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
Yes I understand that. What Paul was looking for was a concat function that was (indigenous was perhaps not the best term) part of the core sql engine, in the same way that Min,Max, stdDev are. ie, the Concat would take 1 argument (and possibly a delimeter), and when run in an aggregate sql would concat all values of the single column specified that fell into the group-by set, putting the result in the single aggregate row.
I guess there are lots of wish-lists for functions to be run in aggregate like that, but for now it looks like a procedural approach is the way to go.
--Jim
I guess there are lots of wish-lists for functions to be run in aggregate like that, but for now it looks like a procedural approach is the way to go.
--Jim
MichaelRed
Programmer
jerby DID state that his functions were both untested and possibly subject to 'improvement':
Concat and Mode are (at least) subject to different approaches which result in fewer lines of code. Median fail to account for the 50% of instances where the recordset has an even # of records.
In refering to the Excel functions reference manual (an OLD copy), I did note the specific functions were limited to a specific number of arguments, however each also accepted an array -and it is not clear that the array cannot have more than the # args). So there are at least two reasons for ME to offer the alternatives.
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
Concat and Mode are (at least) subject to different approaches which result in fewer lines of code. Median fail to account for the 50% of instances where the recordset has an even # of records.
In refering to the Excel functions reference manual (an OLD copy), I did note the specific functions were limited to a specific number of arguments, however each also accepted an array -and it is not clear that the array cannot have more than the # args). So there are at least two reasons for ME to offer the alternatives.
Code:
Public Function basConcat(MyField As String, _
MyTable As String, _
Optional MyRel As String = "", _
Optional MyCriteria As String = "", _
Optional Delim As String = "") As String
Dim sql As String
Dim rst As DAO.Recordset
Dim RtnStr As String
sql = "Select " & MyField & " From " & MyTable
If (MyCriteria <> "") Then
sql = sql & " Where " & " " & MyField & " " & MyRel & " " & Chr(34) & MyCriteria & Chr(34)
End If
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If (rst.EOF = True And rst.BOF = True) Then
basConcat = ""
Else
RtnStr = ""
While Not rst.EOF
RtnStr = RtnStr & rst.Fields(MyField) & Delim
rst.MoveNext
Wend
End If
basConcat = Left(RtnStr, Len(RtnStr) - Len(Delim))
End Function
Public Function basMode(MyField As String, _
MyTable As String, _
MyCriteria As String) As Variant
Dim sql As String
Dim rst As DAO.Recordset
sql = "Select " & MyField & ""
sql = sql & ", Count(" & MyField
sql = sql & ") As FieldCount "
sql = sql & "From " & MyTable
If (MyCriteria <> "") Then
sql = sql & " Where " & " " & MyField & " " & MyCriteria & " "
End If
sql = sql & " Group By " & MyField
sql = sql & " Order By Count(" & MyField & ") Desc;"
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rst.EOF = True And rst.BOF = True Then
basMode = ""
Else
rst.MoveFirst
basMode = rst(MyField)
End If
End Function
Public Function basMedian(MyField As String, _
MyTable As String, _
MyCriteria As String) As Double
Dim sql As String
Dim rst As DAO.Recordset
Dim intMiddle As Integer
Dim NumToCalc As Integer
Dim valMedian As Double
sql = "Select " & MyField & " From " & MyTable
If MyCriteria <> "" Then
sql = sql & " Where " & MyCriteria
End If
sql = sql & " Order By " & MyField
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If (rst.EOF = True And rst.BOF = True) Then
basMedian = 0
Else
rst.MoveLast
rst.MoveFirst
For intMiddle = 1 To rst.RecordCount \ 2
rst.MoveNext
Next intMiddle
NumToCalc = (rst.RecordCount \ 2) Mod 2
For intMiddle = 1 To NumToCalc
valMedian = rst.Fields(MyField) + basvalMedianMedian
Next intMiddle
basMedian = valMedian / (NumToCalc - 1)
End If
End Functionm.red@att.net
There is never time to do it right but there is always time to do it over
- Status
Similar threads
- Locked
- Question
- Locked
- Question
