Dim i As Long 
Private Type ListData 
    strsizey As String 
    strsizex As String 
End Type  
 
Private Sub Document_ContentControlOnExit(ByVal contentcontrol As contentcontrol, Cancel As Boolean) 
    Dim tData As ListData 
    If Application.Version < "14.0" Then Main.SetDeveloperTabActive 
    Select Case contentcontrol.Tag   
    Case Is = "SizeSeries" 
        tData = GetDataIII(contentcontrol) 
        With  ActiveDocument 
            With .SelectContentControlsByTitle("SizeY").Item(1) 
                .LockContents = False 
                .Range.Text = tData.strsizey 
                .LockContents = True 
            End With 
            With .SelectContentControlsByTitle("SizeX").Item(1) 
                .LockContents = False 
                .Range.Text = tData.strsizex 
                .LockContents = True 
            End With 
        End With 
    End Select 
lbl_Exit: 
    Exit Sub 
End Sub
 
Private Function GetOfficeCCforRow(rng, ccTitle) As Word.contentcontrol 
    Dim ccs As Word.ContentControls 
    Dim cc As Word.contentcontrol 
    Dim ccFound As Word.contentcontrol 
    Set ccs = rng.Parent.SelectContentControlsByTag(ccTitle) 
    For Each cc In ccs 
        If cc.Range.InRange(rng.Cells(2).Range) Then 
            Set ccFound = cc 
        End If 
    Next 
    Set GetOfficeCCforRow = ccFound 
End Function  
 
Private Function GetDataIII(ByRef oCCPassed) As ListData 
    Dim arrData() As String 
    For i = 1 To oCCPassed.DropdownListEntries.Count 
        If oCCPassed.Range.Text = oCCPassed.DropdownListEntries(i).Text Then 
            arrData() = Split(oCCPassed.DropdownListEntries(i).Value, "|") 
            Exit For 
        End If 
    Next i 
    On Error Goto Err_NoPick 
    GetDataIII.strsizey = arrData(0) 
    GetDataIII.strsizex = arrData(1) 
    Exit Function 
Err_NoPick: 
    GetDataIII.strsizey = "" 
    GetDataIII.strsizex = "" 
lbl_Exit: 
    Exit Function 
End Function

Option Explicit
 
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean) 
    Dim doc As Word.Document 
    Set doc = ContentControl.Parent 
    If ContentControl.Type = wdContentControlDropdownList Then 
        If InStr(ContentControl.Title, "Project Manager") <> 0 Then 
            Dim cellCC As Word.ContentControl 
            Dim officeCC As Word.ContentControl 
            Dim faxCC As Word.ContentControl 
            Dim rowRange As Word.Range          
            Set rowRange = ContentControl.Range.Rows(1).Range 
            Set officeCC = GetOfficeCCforRow(rowRange, "PhoneOffice") 
            Set cellCC = GetOfficeCCforRow(rowRange, "PhoneCell") 
            Set faxCC = GetOfficeCCforRow(rowRange, "PhoneFax") 
            Select Case ContentControl.Range.Text 
            Case "User1" 
                officeCC.Range.Text = "User1 office" 
                cellCC.Range.Text = "User1 cell" 
                faxCC.Range.Text = "User1 fax" 
            Case "User2" 
                officeCC.Range.Text = "User2 office" 
                cellCC.Range.Text = "User2 cell" 
                faxCC.Range.Text = "User2 fax" 
            Case "User3" 
                officeCC.Range.Text = "User3 office" 
                cellCC.Range.Text = "User3 cell" 
                faxCC.Range.Text = "User3 fax" 
            End Select 
        End If 
    End If 
End Sub 
 
Private Function GetOfficeCCforRow(rng, ccTitle) As Word.ContentControl 
    Dim ccs As Word.ContentControls 
    Dim cc As Word.ContentControl 
    Dim ccFound As Word.ContentControl 
    Set ccs = rng.Parent.SelectContentControlsByTag(ccTitle) 
    For Each cc In ccs 
        If cc.Range.InRange(rng.Cells(2).Range) Then 
            Set ccFound = cc 
        End If 
    Next 
    Set GetOfficeCCforRow = ccFound 
End Function