Often your users will need to add new items to a combo box. How you do that will depend on several factors.
In most cases you will use a table as the RowSource for a combo box. That simplifies filtering and sorting the RowSource, for example when you create cascading (dependent) combo boxes. However, you don't always know what data needs to be displayed. For example, scheduling systems will often require several dates from the current date (the next 4 Mondays or the next 14 days).
To create a list of the next n Mondays, Access provides a callback function called ListMondays. You can find it in the Help, but the documentation isn't all that good. The function is shown below: it needs to be pasted into a standard module.
Function ListMondays(fld As Control, id As Variant, _ row As Variant, col As Variant, code As Variant) _ As Variant Dim intOffset As Integer Select Case code Case acLBInitialize ' Initialize. ListMondays = True Case acLBOpen ' Open. ListMondays = Timer ' Unique ID. Case acLBGetRowCount ' Get rows. ListMondays = 12 Case acLBGetColumnCount ' Get columns. ListMondays = 1 Case acLBGetColumnWidth ' Get column width. ListMondays = -1 ' Use default width. Case acLBGetValue ' Get the data. intOffset = Abs((9 - Weekday(Now)) Mod 7) - 28 ListMondays = Format(Now() + _ intOffset + 7 * (row - 1), "dd-mmm-yyyy") End Select End Function
To adjust this function for your needs, there are only 3 rows that you need to alter. They are:
Change the number of rows to display (in this case, 12)
Case acLBGetRowCount ' Get rows. ListMondays = 12
Change the day to use, and the offset value that determines the starting date
Case acLBGetValue ' Get the data. intOffset = Abs((9 - Weekday(Now)) Mod 7) - 28
The expression in parentheses sets the day of the week. For example, the 9 in the above expression ensures that you will get a Monday as the first date in the sequence. The logic goes like this:
Build the list of dates
ListMondays = Format(Now() + _ intOffset + 7 * (row - 1), "dd-mmm-yyyy")
It's not obvious from the construction of this function but this is the loop that builds the list. Change the date format to suit your requirements.
To use this function, the Row Source Type of the combo box needs to be changed so that it reads ListMondays -- the name of the callback function. Leave the Row Source blank.
In Access XP and later, you can use AddItem to build a value list. Typically, you would create the list when the form loads, as in the sample code below which populates a combo box with the months of the year.
Private Sub Form_Load() Dim intMonth As Integer 'set the rowsource type Me.cmbMonth.RowSourceType = "Value List" 'clear the current list and set the column count to 1 Me.cmbMonth.RowSource = vbNullString Me.cmbMonth.ColumnCount = 1 'populate the list For intMonth = 1 To 12 Me.cmbMonth.AddItem Format(DateSerial(Year(Now()), intMonth, 1), "mmmm") Next intMonth End Sub
If you are using an older version than Access XP, you can't use the AddItem method. In that case you need to build the list by adding the delimiting semi-colons, and then setting the RowSource to the new list. The equivalent code to the last example is shown below:
Private Sub Form_Load() Dim intMonth As Integer Dim strItems As String 'set the rowsource type Me.cmbMonth.RowSourceType = "Value List" 'clear the current list and set the column count to 1 Me.cmbMonth.RowSource = vbNullString Me.cmbMonth.ColumnCount = 1 strItems = vbNullString 'populate the list For intMonth = 1 To 12 strItems = strItems & ";" & Format(DateSerial(Year(Now()), intMonth, 1), "mmmm") Next intMonth 'remove the first semi-colon from the list strItems = Mid(strItems, 2) 'reset the RowSource to the newly created string Me.cmbMonth.RowSource = strItems End Sub
Me.cmbMonth.AddItem Format(DateSerial(Year(Now()), intMonth + 6, 1), "mmmm")
In the example above, the first month in the list is July and the month names wrap around to June: suitable for the Australian financial year.
If you are only populating a single field, this routine will create a new record in the table and refresh the combo box to display the new entry. It has been written to be generic: you will need to change the names of four items in the code to make it work for your situation.
Note: The following settings are required for the code to work:
Private Sub YourCombo_NotInList(NewData As String, Response As Integer) 'LimitToList property must be set to Yes. 'Requires a reference to the Microsoft DAO 3.6 Object Lirary On Error GoTo ErrorHandler 'strings used for the MsgBox Dim strTitle As String Dim strMsg1 As String Dim strMsg2 As String Dim strMsg As String 'buttons to display on the MsgBox Dim intMsgDialog As Integer 'result returned from the MsgBox Dim intResult As Integer 'object variables Dim cbx As Access.ComboBox Dim dbs As DAO.Database Dim rst As DAO.Recordset 'field and table names Dim strTable As String Dim strEntry As String Dim strFieldName As String 'The name of the lookup table -- edit to suit strTable = "YourTable" 'The type of item to add to the table -- edit to suit strEntry = "Descriptive text" 'The field in the lookup table in which the new entry is stored -- edit to suit strFieldName = "YourField" 'The combo box that you are updating -- edit to suit Set cbx = Me![YourComboBox] 'Display a message box asking whether the user wants to add a new entry. strTitle = strEntry & " is not in the list" intMsgDialog = vbYesNo + vbExclamation + vbDefaultButton1 strMsg1 = "Do you want to add " strMsg2 = " as a new " & strEntry & " entry?" strMsg = strMsg1 + NewData + strMsg2 intResult = MsgBox(strMsg, intMsgDialog, strTitle) If intResult = vbNo Then 'Cancel adding the new entry to the lookup table. Response = acDataErrContinue cbx.Undo Exit Sub ElseIf intResult = vbYes Then 'Add a new record to the lookup table. Set dbs = CurrentDb Set rst = dbs.OpenRecordset(strTable) rst.AddNew rst(strFieldName) = NewData rst.Update rst.Close 'Continue without displaying default error message. Response = acDataErrAdded End If ErrorHandlerExit: Exit Sub ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & _ Err.Description Resume ErrorHandlerExit End Sub