Delete Unchecked Multiple Choice Answers

[deboer]

Hi Macropod,
I look for the macro in https://www.msofficeforums.com/word-...le-choice.html that you created and maybe could be helpful for a similar situation.

How can I create a macro that will delete the unneeded answers to a multiple choice question?

The questions are in plain text, with "A", "B", "C", "D", & "E".

But the "right" answer instead of being BOLDed and UNDERLINEd is selected by checkbox Content Control.

Example:
Test Question


answer A
X answer B
answer C
answer D
answer E

It is possible the macro run with the document protected?



Thks

[macropod]

As you can see from the preceding discussion, the solution depends on being able to identify what the possible answers are and, of those, which is the 'correct' answer. Without knowing more about the structure of your document, I can't say how amenable it might be to this kind of processing. Can you attach a document to a post with some representative data (delete anything sensitive)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

PS: Please don't send PMs seeking help.

[deboer]

Hi Paul,

As requested i attach a sample document for your analysis.
Basically what i want is to delete the rows of the answers not checkbox selected (anwser A, B and C).
If it is possible the macro run with the document protected it woul be better.

Thks

[macropod]

For a protected document using checkbox content controls as depicted in your sample, you would need code like:

Sub Demo()
Application.ScreenUpdating = False
Dim CCtrl As ContentControl, i As Long
Dim Pwd As String, pState As Variant
With ActiveDocument
  If .ProtectionType <> wdNoProtection Then
    Pwd = InputBox("Please enter the Password", "Password")
    pState = .ProtectionType
    .Unprotect Pwd
  End If
  With .Range
    For i = .ContentControls.Count To 1 Step -1
      With .ContentControls(i)
        If .Type = wdContentControlCheckBox Then
          If .Checked = False Then
            With .Range.Rows(1)
              .Range.Delete
              .Delete
            End With
          End If
        End If
      End With
    Next
  End With
  If pState <> wdNoProtection Then .Protect Type:=pState, NoReset:=True, Password:=Pwd
End With
Application.ScreenUpdating = True
End Sub

[deboer]

Amazing Paul!
Thank you so much, you're fantastic! That's exactly what I want.
You solved me a big problem.