Add-to Combo Boxes.mdb
Introduction
Combo boxes let you select an item from a row source (usually a lookup table), and (if Limit to List is set to False) to manually type in an entry. However, if you type in a new item, it is not saved to the combo box's row source, so it won't be available in future when you select an item. This article shows how to create add-to combo boxes that let users enter a new list item on-the-fly, and save the new entry to the row source so it will be available in future.
Creating a Simple Add-to Combo Box
If you have a combo box whose row source is a lookup table with a single field, or one data field and an AutoNumber ID field, you can implement an add-to combo box with just code on the combo box's NotInList event, with Limit to List set to True. Note that I have added the standard data type prefixes to the event's arguments. The control name and the four variable settings (strTable, strEntry, strFieldName and cbo) are the only parts that need modification for your database object names.
VBA Code
Private Sub cboCategoryID_NotInList(strNewData As String, intResponse As Integer)
'Set Limit to List to Yes
'Created by Helen Feddema 30-Mar-2017
'Last modified 30-Mar-2017
On Error GoTo ErrorHandler
Dim intResult As Integer
Dim strTitle As String
Dim intMsgDialog As Integer
Dim strMsg1 As String
Dim strMsg2 As String
Dim strMsg As String
Dim cbo As Access.ComboBox
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strTable As String
Dim strEntry As String
Dim strFieldName As String
'The name of the table that is the combo box's row source
strTable = "tblCategoriesSimple"
'The type of item to add to the table
strEntry = "Category"
'The field in the lookup table in which the new entry is stored
strFieldName = "CategoryName"
'The add-to combo box
Set cbo = Me![cboCategoryID]
'Display a message box asking whether the user wants to add
'a new entry.
strTitle = strEntry & " not in list"
intMsgDialog = vbYesNo + vbExclamation + vbDefaultButton1
strMsg1 = "Do you want to add "
strMsg2 = " as a new " & strEntry & " entry?"
strMsg = strMsg1 + strNewData + strMsg2
intResult = MsgBox(strMsg, intMsgDialog, strTitle)
If intResult = vbNo Then
'Cancel adding the new entry to the lookup table.
intResponse = acDataErrContinue
cbo.Undo
GoTo ErrorHandlerExit
ElseIf intResult = vbYes Then
'Add a new record to the lookup table.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strTable)
rst.AddNew
rst(strFieldName) = strNewData
rst.Update
rst.Close
'Continue without displaying default error message.
intResponse = acDataErrAdded
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
To test this code, open frmProductsSimple in the sample database (Add-to Combo Boxes.mdb). When you type in a new category name, you will get the message box shown below:
If you click Yes, the new category is added to the row source table, and the combo box's list is requeried. The new category is now in the lookup table, and is now available for selection on all records.
Creating an Add-to Combo Box with a Data Entry Form
If you want to add new entries to a table that has more than one or two fields, a different technique is needed: opening up a form that has all the fields needed to create a new record, with code on its buttons to either discard or save the new entry. As with the simple add-to combo box code, the control name and the four variable settings (strTable, strEntry, strFieldName and cbo) are the only parts that need modification for your database object names.
Private Sub cboCategoryID_NotInList(strNewData As String, intResponse As Integer)
'Created by Helen Feddema 30-Mar-2017
'Last modified 30-Mar-2017
On Error GoTo ErrorHandler
Dim rst As DAO.Recordset
Dim frm As Access.Form
Dim strForm As String
Dim strFilter As String
Dim strTable As String
Dim strEntry As String
Dim cbo As Access.ComboBox
Dim intMsgDialog As Integer
Dim strMsg1 As String
Dim strMsg2 As String
Dim strMsg As String
Dim strDescription As String
Dim strFieldName As String
Dim strTitle As String
Dim intResult As Integer
'The name of the table that is the combo box's row source
strTable = "tblCategoriesComplex"
'The name of the form
strForm = "frmNewCategory"
'The type of item to add to the table
strEntry = "Category"
'The field in the lookup table in which the new entry is stored
strFieldName = "CategoryName"
'The add-to combo box
Set cbo = Me![cboCategoryID]
'Display a message box asking whether the user wants to add
'a new entry.
strTitle = strEntry & " not in list"
intMsgDialog = vbYesNo + vbExclamation + vbDefaultButton1
strMsg1 = "Do you want to add "
strMsg2 = " as a new " & strEntry & " entry?"
strMsg = strMsg1 + strNewData + strMsg2
intResult = MsgBox(strMsg, intMsgDialog, strTitle)
If intResult = vbNo Then
'Cancel adding the new entry to the lookup table.
intResponse = acDataErrContinue
cbo.Undo
GoTo ErrorHandlerExit
ElseIf intResult = vbYes Then
'Add a new record to the lookup table.
Set rst = CurrentDb.OpenRecordset(strTable)
rst.AddNew
rst.Fields(strFieldName) = strNewData
rst.Update
rst.Close
cbo.Undo
'Continue without displaying default error message
intResponse = acDataErrContinue
'Open form for adding new category
DoCmd.OpenForm strForm
Set frm = Forms(strForm)
strFilter = "[" & strFieldName & "] = " & Chr$(39) _
& strNewData & Chr$(39)
Debug.Print "Filter string: " & strFilter
frm.FilterOn = True
frm.Filter = strFilter
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
To test this code, open frmProductsComplex and type a new entry into the Category combo box; this time, after clicking Yes on the message box, frmNewCategory opens, where you can fill in all the fields in tblCategoriesComplex, including selecting an image for the bound object control, and then click one of two buttons to either discard or save the new category, as shown below.
The code on the Discard and Save buttons is listed below:
Private Sub cmdDiscard_Click()
'Created by Helen Feddema 30-Mar-2017
'Last modified by Helen Feddema 30-Mar-2017
On Error GoTo ErrorHandler
Set prj = Application.CurrentProject
'Name of the form with the add-to combo box
strCallingForm = "frmCategoriesComplex"
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdDeleteRecord
If prj.AllForms(strCallingForm).IsLoaded Then
Forms(strCallingForm).Visible = True
Else
DoCmd.OpenForm strCallingForm
End If
Set frm = Forms(strCallingForm)
'Name of add-to combo box
Set cbo = frm![cboCategoryID]
cbo.Value = Null
ErrorHandlerExit:
DoCmd.Close acForm, Me.Name
Exit Sub
ErrorHandler:
If Err.Number = 2467 Then
Resume ErrorHandlerExit
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Sub
Private Sub cmdSave_Click()
'Created by Helen Feddema 30-Mar-2017
'Last modified 30-Mar-2017
On Error GoTo ErrorHandler
Set prj = Application.CurrentProject
'Name of the form with the add-to combo box
strCallingForm = "frmProductsComplex"
'The textbox control on this form that holds the key value
Set txt = Me![txtCategoryID]
If prj.AllForms(strCallingForm).IsLoaded = True Then
Forms(strCallingForm).Visible = True
Else
DoCmd.OpenForm strCallingForm
End If
Set frm = Forms(strCallingForm)
'Name of add-to combo box
Set cbo = frm![cboCategoryID]
cbo.Requery
cbo.Value = Nz(txt.Value)
ErrorHandlerExit:
DoCmd.Close acForm, Me.Name
Exit Sub
ErrorHandler:
If Err.Number = 2467 Then
Resume ErrorHandlerExit
Else
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Sub
If you click Yes, the new entry is selected in the combo box, and it can be selected in future for other records:
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (0)