Do not accept duplicate values in a cell from a multiselect dropdown list

[Nirbhay Sharma]

Hi all

I have implemented a multiselect dropdown list. This list basically allows a user to select multiple values in a cell seperated by a semi-colon. The multi-select dropdown was implemented using a macro on the sheet. (plz refer sample).

The issue i am facing is that one can select the same value from the list again and again.
example:
say the drop down contains these values: OC,CC,WC,ID.
The user first selects the value OC in cell D2. The cell gets the value OC.
Now he selects value CC from the dropdown, the cell value becomes "OC; CC"
Next if he select OC again, the cell value becomes "OC; CC; OC".

This is an error and shouldnt be accepted.

Also i gathered this method can be used to determine whether the new value is already present in the cell or not.
the formula is:

=IF(ISNUMBER(SEARCH("<new_value>",D2)), TRUE, IF(ISNUMBER(SEARCH("<new_value>",D2)), TRUE, IF(ISNUMBER(SEARCH("<new_value>",D2)), TRUE, IF(ISNUMBER(SEARCH("<new_value>",D2)), TRUE, FALSE))))

now instead of D2 we have to use the target cell (the way it is used in the macro).

if a flag can be set which will check whether the <new_value> is already present withing the <target_cell>; and if it is TRUE (it is present) it can give an error dialog box saying "select unique values"; the solution can be achieved.

Can you guys please have a look at it.
I am attaching the sample also for reference.

Thanks in advance.

 

[Luke M]

Change the code to this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim check As Boolean
Dim sheet As Worksheet

If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
    GoTo exitHandler
Else
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    If oldVal <> "" And newVal <> "" Then
        'Check for unique value
        If InStr(1, oldVal, newVal, vbTextCompare) Then
            MsgBox "Select unique values", vbOKOnly + vbCritical, "Not Unique"
            Target.Value = oldVal
        Else
            Target.Value = oldVal & "; " & newVal
        End If
    End If
End If

exitHandler:
Application.EnableEvents = True
End Sub

 

[Nirbhay Sharma]

hi luke
first of all thanks for the help.
i actually did some trial and error before your reply and implemented the following code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim check As Integer

If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
WorksheetFunction.If

Else

   Application.EnableEvents = False
   newVal = Target.Value
   Application.Undo
   oldVal = Target.Value
   Target.Value = newVal
   check = InStr(oldVal, newVal)
   'MsgBox ("check= " & check)
   If oldVal = "" Or newVal = "" Then
   Else
      If check <> 0 Then
         MsgBox ("Please Enter Unique Values Only!")
         Target.Value = oldVal
      Else
   
         If oldVal = "" Then
         Else
     
            If newVal = "" Then
            Else
               Target.Value = oldVal & "; " & newVal
            End If
   
         End If
      End If
   End If
End If

Application.EnableEvents = True
exitHandler:
  Application.EnableEvents = True
End Sub

This works for me
still thanks for the reply.