Option Explicit
Dim StrOption As String
Private Sub Document_ContentControlOnEnter(ByVal CCtrl As ContentControl)
If CCtrl.Title = "Service Team" Then StrOption = CCtrl.Range.Text
End Sub
 
Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim i As Long, StrOut As String
Dim strDetails As String
With CCtrl
  If .Title = "Service Team" Then
    If StrOption = .Range.Text Then Exit Sub
    Select Case .Range.Text
    Case "Producer"
        StrOut = "Apples,Banna,Pear,Oranges"
    Case "Account Manager"
        StrOut = "Math,History,English,Art"
    Case "Claims Advocate"
        StrOut = "Scissors,Paper,Rock"
    Case Else
        .Type = wdContentControlText
        .Range.Text = ""
        .Type = wdContentControlDropdownList
    End Select
    With ActiveDocument.SelectContentControlsByTitle("Contact Name")(1)
    .DropdownListEntries.Clear
    For i = 0 To UBound(Split(StrOut, ","))
        .DropdownListEntries.Add Split(StrOut, ",")(i)
    Next
    .Type = wdContentControlText
    .Range.Text = ""
    .Type = wdContentControlDropdownList
    End With
  End If
  If .Title = "Contact Name" Then
  For i = 1 To .DropdownListEntries.Count
    If .DropdownListEntries(i).Text = .Range.Text Then
    strDetails = Replace(.DropdownListEntries(i).Value, "|", Chr(11))
    Exit For
    End If
  Next
  ActiveDocument.SelectContentControlsByTitle("Contact Details").Item(1).Range.Text = strDetails
  End If
End With
Application.ScreenUpdating = True
End Sub