By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,855 Members | 1,988 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

MS Access Calculated List

Expert 100+
P: 344
I have not seen this feature documented before, so I thought I would share it with you, as I will be using it in a later article.

For a combo or list box, the source data is normally a Table/Query. Or it could be a value list, a static list of data.

But what if your information is not held in a table, and it is not a static list.

Examples I have used have been, “next 100 prime numbers after this one”, “Every third Friday from start of next month”, “All tables in my database that start “tlk”, “All users in the MDW file” and many other lists that are a calculated or derived function.

There is another type of row source type for combo and list boxes and that is using a global recursive function that is structured in a specific way.

This function will return a single column of data, calculated by a global function.

In order to use this, you need first to create your combo or list box, say cboLookup on your form.
Leave the RowSourceType as Table/Query but don’t assign a RowSource.

In the on-open event of the form, assign the RowSourceType of your box to your global function. (The function must be in a standard module, not in the form's module)
Expand|Select|Wrap|Line Numbers
  1. cboLookup.RowSourceType = "ListLookup"
You then have to write your function. The function ListLookup shown here returns a list of all the tables in my database begining tlk. I use it to edit lookup tables.

Expand|Select|Wrap|Line Numbers
  1. Function ListLookup(fld As Control, id, row, col, Code) As Variant
  2. '   Author Mark Fisher
  3. '   Description
  4. '   Returns a function list of all lookup tables, up to a max of 100
  5. '   Note, this can't go in a form, it must be global!!!
  6.  
  7.  
  8.     On Error GoTo Err_ListLookup
  9.     Static astrTables(100) As String, entries As Integer
  10.     Dim returnval As Variant
  11.     Dim i As Integer, j As Integer
  12.     Dim db As Database
  13.  
  14.     Dim intCount As Integer
  15.     returnval = Null
  16.  
  17.     Select Case Code
  18.         Case 0
  19.             Set db = CurrentDb
  20.             intCount = 0
  21.             For i = 0 To db.Containers.Count - 1
  22.                 If db.Containers(i).Name = "Tables" Then
  23.                     For j = 0 To db.Containers(i).Documents.Count - 1
  24.                     If Left(db.Containers(i).Documents(j).Name, "3") = "tlk" Then
  25.                         If db.Containers(i).Documents(j).Name = "tlkText" Or db.Containers(i).Documents(j).Name = "tlkTranslate" Then
  26.                             'do nowt
  27.                         Else
  28.                             astrTables(intCount) = db.Containers(i).Documents(j).Name
  29.                             intCount = intCount + 1
  30.                         End If
  31.                     End If
  32.                     Next
  33.                 End If
  34.             Next
  35.             entries = intCount
  36.             Set db = Nothing
  37.  
  38.             returnval = entries
  39.         Case 1
  40.             returnval = Timer
  41.         Case 3
  42.             returnval = entries
  43.         Case 4, 5
  44.             returnval = -1
  45.         Case 6
  46.             returnval = astrTables(row)
  47.         Case 9
  48.             For entries = 0 To 100
  49.                 astrTables(entries) = ""
  50.             Next
  51.         End Select
  52.         ListLookup = returnval
  53. Exit_ListLookup:
  54.     Exit Function
  55. Err_ListLookup:
  56.     If Not Err Then
  57.         MsgBox "Contact Support" & vbCrLf & "Error " & Err & " in ListLookup " & vbCrLf & Error$, _
  58.                16, "Error in Global Module"
  59.         Resume Exit_ListLookup
  60.     End If
  61.  
  62. End Function
  • You must use the calling parameters as shown, i.e. fld As Control, id, row, col, Code.
  • You need an array to store the list results, I use astrTables(). This must be a static array (which persists after the function exits) and must be large enough to hold your maximum entries.
  • All the structure of the case statement must be retained, like I said, I have never seen this documented so it took trial and error to get it working from a magazine example yonks ago.
  • This function is called many times, with different values of Code, and no, I don’t know what does the calling, I just know it works.

Case 9 is the initialization. This is where you empty your array
Case 6 is where you return the rowth value of your array
Case 3 returns the count of entries to be displayed
Case 0 is where you design your function to make up your list. In this case, I loop through the table container, looking for tablenames I want, and adding them to the list, increasing the count along the way.

I have no idea what the other cases do, I leave them alone and the function works.

Here is another listfunction that returns all the users in the MDW file that belong to my ‘staff’ group
Expand|Select|Wrap|Line Numbers
  1. Function ListUsers(fld As Control, id, row, col, Code)
  2.  
  3. '   Author Mark Fisher
  4. '   Description
  5. '   Returns a function list of all users, up to a max of 300
  6. '   Note, this can't go in a form, it must be global!!!
  7. '
  8.     On Error GoTo Err_ListUsers
  9.     Static astrUserNames(300)  As String, entries  As Integer
  10.     Dim returnval
  11.     Dim wks As Workspace
  12.     Dim usr As User, intGrp As Integer, onlystaff As Boolean, isStaff As Boolean, intCount As Integer
  13.     returnval = Null
  14.  
  15.     Select Case Code
  16.         Case 0
  17.             Set wks = DBEngine.CreateWorkspace("", SECUREUSER, SECUREPASSWORD)
  18.             intCount = 0
  19.             For entries = 0 To wks.Users.Count - 1
  20.  
  21.                 isStaff = False
  22.                 onlystaff = True
  23.                 Set usr = wks.Users(entries)
  24.                 For intGrp = 0 To usr.Groups.Count - 1
  25.                     If usr.Groups(intGrp).Name = "Staff" Then
  26.                         isStaff = True
  27.                     ElseIf usr.Groups(intGrp).Name = "Users" Then
  28.                         'ignore it
  29.                     Else
  30.                         onlystaff = False
  31.                     End If
  32.                 Next intGrp
  33.                 If isStaff And onlystaff Then
  34.                     astrUserNames(intCount) = wks.Users(entries).Name
  35.                     intCount = intCount + 1
  36.                 End If
  37.             Next entries
  38.             entries = intCount
  39.             Set usr = Nothing
  40.             wks.Close
  41.             Set wks = Nothing
  42.             returnval = entries
  43.         Case 1
  44.             returnval = Timer
  45.         Case 3
  46.             returnval = entries
  47.         Case 4, 5
  48.             returnval = -1
  49.         Case 6
  50.             returnval = astrUserNames(row)
  51.         Case 9
  52.             For entries = 0 To 300
  53.                 astrUserNames(entries) = ""
  54.             Next
  55.         End Select
  56.         ListUsers = returnval
  57. Exit_ListUsers:
  58.     Exit Function
  59. Err_ListUsers:
  60.     If Not Err Then
  61.         MsgBox "Contact Support" & vbCrLf & "Error " & Err & " in ListUsers " & vbCrLf & Error$, _
  62.                16, "Error in Global Module"
  63.         Resume Exit_ListUsers
  64.     End Select
  65.  
  66. End Function
Hope this makes sense, and is some use to someone.
Jul 8 '07 #1
Share this Article
Share on Google+
2 Comments


P: 3
Nice tip - these functions are called Call Back functions and have been documented in the on-line help since version 2.0.
Also, note that constants are available for the "code" value.

Here is another example which demonstrates a typical example to display dynamic data not stored in tables:

Expand|Select|Wrap|Line Numbers
  1. Public Function ListDaysOfWeek( _
  2.   ctl As Control, _
  3.   lngId As Long, _
  4.   lngRow As Long, _
  5.   lngCol As Long, _
  6.   intCode As Integer) _
  7.   As Variant
  8.  
  9.   ' Length of week in days.
  10.   Const cbytDaysInWeek  As Byte = 7
  11.   ' Offset of first day in week relative to the first day of the week of today's date.
  12.   Const clngOffset      As Long = cbytDaysInWeek * -1
  13.   ' Choose first day in week to display.
  14.   Const cbytDayInWeek   As Byte = vbMonday
  15.   ' Example: Display days of next week starting with Monday.
  16.   ' Const clngOffset      As Long = cbytDaysInWeek * 1
  17.   ' Const cbytDayInWeek   As Byte = vbMonday
  18.   '
  19.   ' 2002-02-04. Cactus Data ApS, CPH.
  20.  
  21.   Static datFirstDate   As Date
  22.   Static strFormat      As String
  23.  
  24.   Dim datDate           As Date
  25.   Dim lngOffset         As Long
  26.   Dim varValue          As Variant
  27.  
  28.   Select Case intCode
  29.     Case acLBInitialize
  30.       datDate = Date
  31.       lngOffset = clngOffset + 1 - WeekDay(datDate, cbytDayInWeek)
  32.       datFirstDate = DateAdd("d", lngOffset, datDate)
  33.       strFormat = ctl.Format
  34.       varValue = True             ' True to initialize.
  35.     Case acLBOpen
  36.       varValue = Timer            ' Autogenerated unique ID.
  37.     Case acLBGetRowCount          ' Get rows.
  38.       varValue = cbytDaysInWeek   ' Set number of rows.
  39.     Case acLBGetColumnCount       ' Get columns.
  40.       varValue = 1                ' Set number of columns.
  41.     Case acLBGetColumnWidth       ' Get column width.
  42.       varValue = -1               ' Use default width.
  43.     Case acLBGetValue             ' Get the data for each row.
  44.       varValue = DateAdd("d", lngRow, datFirstDate)
  45.     Case acLBGetFormat            ' Format the data.
  46.       varValue = strFormat        ' Use format of control.
  47.     Case acLBEnd
  48.       ' Do something when form with listbox closes or
  49.       ' listbox is requeried.
  50.   End Select
  51.  
  52.   ' Return value.
  53.   ListDaysOfWeek = varValue
  54.  
  55. End Function
/gustav
Aug 2 '07 #2

Expert 100+
P: 344
Nice tip - these functions are called Call Back functions and have been documented in the on-line help since version 2.0.
Also, note that constants are available for the "code" value.
Thanks for the extra information on these functions. I use them a lot, mainly in manipulating users and security groups.
Aug 3 '07 #3