PDA

View Full Version : Code for populating a dropdown doesn't like duplicates



jrooney7
09-22-2021, 02:01 PM
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:


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!