Home > Validation > Drop Downs > Macros Drop Down Lists - Allow Some Users Add New ItemsHow to allow some users to add new items to Excel Data Validation drop down lists, and block people who don't have permission to add items. Get the free workbook with sample macro |
In this Excel data validation example, you'll create an Excel Data Validation drop down list that allows one specific user to add new items. The new data validation items will be automatically added to the drop down list, and the list will be sorted alphabetically.
This technique isn't foolproof, and anyone who's determined to circumvent it would be able to. But, it's a good way to remind people that they can't update the list without permission.
For instructions on setting up the worksheets and List sheet sort code, see the Excel Data Validation - Add New Items page. Follow those instructions, up to the Data Entry Code section. Then return to this page for the Data Entry Code.
The Data Entry code shown here will allow only one specific user
to add new items. All other users will see a message that says they're
not allowed to add items.
On the worksheet code module for the DataEntry sheet, you'll add code that runs automatically if a change is made on the worksheet.
To add the Excel VBA code, follow these steps:
Private Sub Worksheet_Change _ (ByVal Target As Range) On Error Resume Next Dim ws As Worksheet Dim str As String Dim i As Integer Dim rngDV As Range Dim rng As Range Dim strUser As String strAuth = "Debra Dalgleish" strUser = Application.UserName Application.EnableEvents = False If Target.Count > 1 Then GoTo exitHandler Set ws = Worksheets("Lists") If Target.Row > 1 Then On Error Resume Next Set rngDV = Cells _ .SpecialCells(xlCellTypeAllValidation) On Error GoTo 0 If rngDV Is Nothing Then GoTo exitHandler If Intersect(Target, rngDV) Is Nothing _ Then GoTo exitHandler str = Target.Validation.Formula1 str = Right(str, Len(str) - 1) On Error Resume Next Set rng = ws.Range(str) On Error GoTo 0 If rng Is Nothing Then GoTo exitHandler If Application.WorksheetFunction _ .CountIf(rng, Target.Value) Then GoTo exitHandler Else If strUser <> strAuth Then MsgBox "You do not have authority " _ & "to add Items. " _ & vbCrLf _ & vbCrLf _ & "Please check with Administrator." Application.Undo GoTo exitHandler Else i = ws.Cells(Rows.Count, rng.Column) _ .End(xlUp).Row + 1 ws.Cells(i, rng.Column).Value _ = Target.Value rng.Sort Key1:=ws.Cells(1, rng.Column), _ Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End If End If End If exitHandler: Application.EnableEvents = True Exit Sub errHandler: MsgBox "Could not add new item" Resume exitHandler End Sub
To see how the sort code works, add your name as the authorized user, and you can add an item to one of the lists:
If your name is different than that of the authorized user, you won't be able to add an item to one of the lists:
First, the code finds the user name associated with the copy of Microsoft Excel:
strUser = Application.UserName
The EnableEvents property is set to False, so any other changes to the worksheet will be ignored, while this code is running.
Application.EnableEvents = False
Then, the code checks to see if more than one cell was changed. If so, the macro stops running:
If Target.Count > 1 Then GoTo exitHandler
Next, the code checks to which row was changed. If it was row 1, where the headings are located, the macro stops running.:
If Target.Row > 1 Then ... End If
Then, the code tries to set a range based on the data validation cells in the worksheet. If there are no data validation cells, the range can't be set, so the macro stops running:
On Error Resume Next Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) On Error GoTo 0 If rngDV Is Nothing Then GoTo exitHandler
Next, the code checks to see if the cell that was changed (Target) intersects with the range of cells that contain data validation. If it doesn't, the macro stops running:
If Intersect(Target, rngDV) Is Nothing Then GoTo exitHandler
Then, the code creates a text string, based on the data validation formula in the changed cell. The Right function removes the first character from the string. For example, if the data validation formula is =ClientList the str variable would be set to ClientList:
str = Target.Validation.Formula1 str = Right(str, Len(str) - 1)
Then, the code tries to set a range based on the str variable. If there is no range with that name on the Lists sheet, the range can't be set, so the macro stops running:
On Error Resume Next Set rng = ws.Range(str) On Error GoTo 0 If rng Is Nothing Then GoTo exitHandler
Then, the code checks that range, by using the COUNTIF worksheet function, to see if the changed cell's value is already in that list. If so, the macro stops running:
If Application.WorksheetFunction _ .CountIf(rng, Target.Value) Then GoTo exitHandler
If the changed cell contains a new item, the code checks to see if the user is authorized to make the change:
If strUser <> strAuth Then MsgBox "You do not have authority to add Items. " _ & vbCrLf _ & vbCrLf _ & "Please check with Administrator."
Then the code removes the unauthorized item from the data validation cell:
Application.Undo GoTo exitHandler
For an authorized user, the code finds the first empty row in the list's column on the Lists sheet:
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
The changed cell's value is added in that empty row on the Lists sheet:
ws.Cells(i, rng.Column).Value = Target.Value
Finally, the code sorts the revised list on the Lists sheet:
rng.Sort Key1:=ws.Cells(1, rng.Column), _ Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom
In the exitHandler, the EnableEvents property is set to True, so changes to the worksheet be detected again, when this procedure stops running.
Application.EnableEvents = True
Download the free workbook with the macro. Excel Data Validation Add Items-User This zipped file contains macros, so be sure to enable them when opening the workbook.
Create Dependent Drop Down Lists
Use a Data Validation List from Another Workbook
Data Validation Criteria Examples
Last updated: January 26, 2023 3:16 PM