Dropdown list dependency and autofill

[LustNik]

Hi

Pretty new to advanced functions in Word, and complete beginner in the world of VBA.

Im trying to create a dropdown list with a secondary, dependent dropdown. First has 2 options: "yes" or "no". In case of "yes", 3 options are presented in the secondary list which will change color according to answer. So far so good!



However, when the "no" option is selected, I would like the secondary dropdown to autofill something along the lines of "N/A" or "—".

None of my attempts at the trusted copy/paste method has worked, so the code below is what I have that works.

Thanks in advance!

Option Explicit
Dim StrOption As String
Private Sub Document_ContentControlOnEnter(ByVal CCtrl As ContentControl)
If CCtrl.Title = "Relevans" 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
With CCtrl
  If .Title = "Relevans" Then
    If StrOption = .Range.Text Then Exit Sub
    Select Case .Range.Text
      Case "Ja"
        StrOut = "Uakseptabel,Middels,Akseptabel"
      Case "Nei"
        StrOut = "—"
      Case Else
        .Type = wdContentControlText
        .Range.Text = ""
        .Type = wdContentControlDropdownList
    End Select
    With ActiveDocument.SelectContentControlsByTitle("Risiko")(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
End With

With CCtrl.Range
    If CCtrl.Title = "Risiko" Then
        Select Case .Text
            Case "Uakseptabel"
                .Cells(1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
            Case "Akseptabel"
                .Cells(1).Shading.BackgroundPatternColor = RGB(0, 176, 80)
            Case "Middels"
                .Cells(1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
            Case Else
                .Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
        End Select
    End If
End With
End Sub