I saw very little evidence in your attached document where you had made any effort to combine the code as I suggested.
Code:
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