Code for populating a dropdown doesn't like duplicates

Hello all,

A while back I asked for help on using entries in one table to populate a dropdown in another table. Mr. Maxey supplied me with the code to solve my problem - thank you again!! But I have since discovered a little issue with the code.

The original ask was: I am working on creating a document that has a table at the beginning with several columns. The second column will be item numbers and the third column will be item descriptions. This table will have a varying number of rows, but the format of each row will be identical. The document will have subsequent tables that the user will add as needed. In each of these subsequent tables the third row will have two cells - the first has a dropdown for item number and the second will be the corresponding description from the 1st table. I would like the dropdown list, titled "Item#", to be populated by the entries in the second column of the first table, and if possible, I would like the corresponding item description to be copied from the 1st table and pasted in the second cell of that row.

The code Mr. Maxey gave me is:

Code:

---

Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
Dim oTbl As Table
Dim lngLE As Long

  Select Case ContentControl.Title
    Case "Item#"
      Set oTbl = ActiveDocument.Tables(1)
      For lngLE = ContentControl.DropdownListEntries.Count To 2 Step -1
        ContentControl.DropdownListEntries(lngLE).Delete
      Next lngLE
      For lngLE = 1 To oTbl.Rows.Count
        ContentControl.DropdownListEntries.Add Left(oTbl.Cell(lngLE, 2).Range.Text, Len(oTbl.Cell(lngLE, 2).Range.Text) - 2), Left(oTbl.Cell(lngLE, 3).Range.Text, Len(oTbl.Cell(lngLE, 3).Range.Text) - 2)
      Next lngLE
  End Select
lbl_Exit:
  Exit Sub
End Sub

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim oTbl As Table
Dim lngLE As Long

  Select Case ContentControl.Title
    Case "Item#"
      Set oTbl = Selection.Range.Tables(1)
      oTbl.Cell(3, 2).Range.Text = vbNullString
      For lngLE = 2 To ContentControl.DropdownListEntries.Count
        If ContentControl.DropdownListEntries(lngLE).Text = ContentControl.Range.Text Then
          oTbl.Cell(3, 2).Range.Text = ContentControl.DropdownListEntries(lngLE).Value
          Exit For
        End If
      Next lngLE
  End Select
lbl_Exit:
  Exit Sub
End Sub

---

Now, it seems that if any two of the item descriptions in the first table are identical, the code will give the following error: "Run-time error '6214': An entry with the same value already exists - each entry must specify a unique value." It will not be uncommon for two items to have identical descriptions. Is there a way to tweak the code so it doesn't care if there are duplicates? The Item numbers will always be unique if that helps.

I hope what I'm asking makes sense :) and thank you for any help!