Dropdown list dependency and autofill

LustNik · #1 03-14-2022, 05:49 AM

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!

Code:

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

gmayor · #2 03-14-2022, 07:01 AM

I think the following will work for the two controls, however it is not clear what .Cells(1) refers to so I have used cell 1 of the first table

Code:

Option Explicit

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
            Select Case .Range.Text
                Case "Ja"
                    StrOut = "Uakseptabel,Middels,Akseptabel"
                    If CCtrl.Range.Text = "Ja" Then
                        With ActiveDocument.SelectContentControlsByTitle("Risiko")(1)
                            .Type = wdContentControlDropdownList
                            .DropdownListEntries.Clear
                            .Type = wdContentControlRichText
                            .Range.Text = ""
                            .Type = wdContentControlDropdownList
                            For i = 0 To UBound(Split(StrOut, ","))
                                .DropdownListEntries.Add Split(StrOut, ",")(i)
                            Next i
                        End With
                    End If
                Case "Nei"
                    With ActiveDocument.SelectContentControlsByTitle("Risiko")(1)
                        If .Type = wdContentControlDropdownList Then
                            .DropdownListEntries.Clear
                        End If
                        .Type = wdContentControlRichText
                        .Range.Text = "—"
                    End With
                Case Else
                    With ActiveDocument.SelectContentControlsByTitle("Risiko")(1)
                        If .Type = wdContentControlDropdownList Then
                            .DropdownListEntries.Clear
                        End If
                        .Type = wdContentControlRichText
                        .Range.Text = ""
                    End With
            End Select
        End If
    End With
    If CCtrl.Title = "Risiko" Then
        If CCtrl.ShowingPlaceholderText = False Then
            With CCtrl.Range
                Select Case .Text
                    Case "Uakseptabel": ActiveDocument.Tables(1).Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
                    Case "Akseptabel": ActiveDocument.Tables(1).Range.Cells(1).Shading.BackgroundPatternColor = RGB(0, 176, 80)
                    Case "Middels": ActiveDocument.Tables(1).Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
                    Case Else: ActiveDocument.Tables(1).Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
                End Select
            End With
        End If
    End If
End Sub

LustNik · #3 03-14-2022, 07:17 AM

That works beautifully! Except the colors in the cells dont change anymore. The cell that is supposed to be colored in, is the one that also holds the text. Does that make sense?

Basically, I need the "risiko" cell to be colored based on the answer. So if you choose "Akseptabel" the cell colors green etc.

LustNik · #4 03-14-2022, 07:46 AM

After further investigation it isnt working properly unfortunately. Dont know if my explanation is too poor, but I have 35-ish cells which should be independent from eachother.

I'll upload a copy of the table im trying to make work for reference.

Guessed · #5 03-14-2022, 02:55 PM

If the applicable Risiko CC is always in the next cell, this should work

Code:

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
  Application.ScreenUpdating = False
  Dim i As Long, StrOut() As String, rngRow As Range, ccRis As ContentControl
  With CCtrl
    If .Title = "Relevans" Then
      Set ccRis = .Range.Cells(1).Next.Range.ContentControls(1)
      Select Case .Range.Text
        Case "Ja"
          StrOut = Split("Uakseptabel,Middels,Akseptabel", ",")
          With ccRis
            .Type = wdContentControlText
            .Range.Text = ""
            .Type = wdContentControlDropdownList
            .DropdownListEntries.Clear
            For i = 0 To UBound(StrOut)
              .DropdownListEntries.Add StrOut(i)
            Next i
          End With
        Case "Nei"
          With ccRis
            .Type = wdContentControlText
            .Range.Text = "—"
          End With
        Case Else
          With ccRis
            .Type = wdContentControlText
            .Range.Text = ""
          End With
      End Select
    ElseIf .Title = "Risiko" Then
      Select Case .Range.Text
        Case "Uakseptabel": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
        Case "Akseptabel": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(0, 176, 80)
        Case "Middels": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
        Case Else: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
      End Select
    End If
  End With
End Sub

macropod · #6 03-14-2022, 03:48 PM

Create one each of your Relevans & Risiko content controls, both with their relevant drop-down entries, then copy them to each of the other cells. Having done that, run the following macro:

Code:

Sub ConfigureRisiko()
Dim CCtrl As ContentControl
For Each CCtrl In ActiveDocument.ContentControls
  With CCtrl
    If .Title = "Risiko" Then
      .Type = wdContentControlRichText
      .Range.Text = " "
      .LockContents = True
    End If
  End With
Next
End Sub

From then on, the only macro you need in the document is:

Code:

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim r As Long, StrIn As String
With CCtrl
  r = .Range.Cells(1).RowIndex
  Select Case .Title
    Case "Relevans"
      StrIn = .Range.Text
      With .Range.Tables(1).Cell(r, 5).Range.ContentControls(1)
        If StrIn = "Ja" Then
          If .Type = wdContentControlRichText Then
            .LockContents = False
            .Range.Text = ""
            .Type = wdContentControlDropdownList
            .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
          End If
        ElseIf StrIn = "Nei" Then
          .LockContents = False
          .Type = wdContentControlRichText
          .Range.Text = "_"
          .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
          .LockContents = True
        Else
          .LockContents = False
          .Type = wdContentControlRichText
          .Range.Text = " "
          .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
          .LockContents = True
        End If
      End With
    Case "Risiko"
      If .LockContents = False Then
        Select Case .Range.Text
          Case "Uakseptabel": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
          Case "Akseptabel": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(0, 176, 80)
          Case "Middels": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
          Case Else: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
        End Select
      End If
  End Select
End With
Application.ScreenUpdating = True
End Sub

LustNik · #7 03-15-2022, 12:28 AM

Both of the last solutions worked! Fantastic, thanks alot for the help.

LustNik · #8 03-15-2022, 02:17 AM

For some reason this solution removes the dropdown options in the "risiko" cells upon closing and then opening the document. It seems to only be the case if nothing has been filled into the cell before exiting.

Preferably I would like to be able to take a copy of the document before filling anything into the table, so I can make multiple copies of that same doc.

Quote:

Originally Posted by macropod

Create one each of your Relevans & Risiko content controls, both with their relevant drop-down entries, then copy them to each of the other cells. Having done that, run the following macro:
...
From then on, the only macro you need in the document is:

macropod · #9 03-15-2022, 02:14 PM

Oops! Add the following code the the document:

Code:

Private Sub Document_Open()
Dim CCtrl As ContentControl, i As Long
With ActiveDocument
  For Each CCtrl In .ContentControls
    With CCtrl
      If .Title = "Risiko" Then
        If .Type = wdContentControlRichText Then
          .LockContents = False
          .Type = wdContentControlDropdownList
          .DropdownListEntries.Add "Uakseptabel"
          .DropdownListEntries.Add "Akseptabel"
          .DropdownListEntries.Add "Middels"
          .Type = wdContentControlRichText
          .LockContents = True
        End If
      End If
    End With
  Next
  .Saved = True
End With
End Sub

or, if being run from a template, add all the code to that template, along with:

Code:

Private Sub Document_New()
Call Document_Open
End Sub

LustNik · #10 03-17-2022, 01:02 AM

This did the trick! Thanks a lot!

Another question: is there anything I can add to control postion and size of the text? I'd like the text t be centered in the cells.

macropod · #11 03-17-2022, 05:34 AM

Quote:

Originally Posted by LustNik

Another question: is there anything I can add to control postion and size of the text? I'd like the text t be centered in the cells.

Simply format the cells as you would if they had ordinary text content.

PS: Please don't quote previous posts in your replies unless there's something specific you need to refer to - and then include only the relevant portion(s). Anything more just adds clutter.

LustNik · #12 03-17-2022, 06:22 AM

Noted. Thanks for all the help! Much appreciated

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Autofill Dropdown	Syed Rashid	Word	1	06-22-2021 10:59 AM
Compose Email - Autofill List Style Change	RoscoW88	Outlook	2	05-24-2021 06:44 PM
Autofill a field based on drop down list selection	lascough20	Word	2	09-21-2018 02:24 AM
Selection of a dropdown creates another dropdown wih the list	krishnamurthy.ka2810	Word VBA	1	04-26-2018 11:44 PM
Autofill a form which is contingent on a dropdown selection.	biffle0764	Word	2	05-09-2012 12:54 PM