How to populate a dropdown list from entries in a table

[jrooney7]

Hello all,

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. I had all of this worked out using Excel dropdowns and Word userforms, but the powers that be have restricted me from using the userforms in this version of the document.

I know it's asking a lot, but any help you can give would be appreciated greatly.

[gmaxey]

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

[jrooney7]

Thank you so much Mr. Maxey! That works like a charm!!

[jrooney7]

I known it's been a while, but I have discovered a little issue with the wonderful code above. 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.