Data Validation - Duplicate Entries using a defined list

[mizogy]

Hi All

Here is the conundrum:

(1) I am using a data validation list to provide the user a defined list of options to select from the drop-down list
(2) This validation table is applied to cells A1:A10
(2) However, I want to avoid them making duplicate selections from the drop-down list in proceeding cells, for example, if they selected 'Apples' from the drop-down list in cell A1, I want to prevent them being able to select 'Apples' again from the drop-down list in the remaining cells A2 to A10.

Any ideas and solutions, most welcome!

Best, Mizogy

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Make a selection in A1 and then in any cell in A2:A10.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    If Intersect(Target, Range("A2:A10")) Is Nothing Then Exit Sub
    If Target = Range("A1") Then
        MsgBox ("You cannot select the value of cell A1.  Please try again.")
        Target.ClearContents
    End If
End Sub

 

[mizogy]

Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Target.Column <> 1 Then Exit Sub If Intersect(Target, Range("A2:A10")) Is Nothing Then Exit Sub If Target = Range("A1") Then MsgBox ("You cannot select the value of cell A1. Please try again.") Target.ClearContents End If End Sub

Thanks Mumps. I want to avoid there being any duplication in the range, for example it could be that 'Oranges' is selected in A2 and A4 from the available drop-down list in each of the cells. I want to avoid there being any duplication in Range A1 to A10.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If WorksheetFunction.CountIf(Range("A1:A10"), Target) > 1 Then
        MsgBox (Target & " has already been selected.  Please try again.")
        Target.ClearContents
    End If
    Application.EnableEvents = True
End Sub

 

[mizogy]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If WorksheetFunction.CountIf(Range("A1:A10"), Target) > 1 Then
        MsgBox (Target & " has already been selected.  Please try again.")
        Target.ClearContents
    End If
    Application.EnableEvents = True
End Sub

Thanks Mump, my apologies for my delayed reply, was on AL

 

[mumps]

You are very welcome.