Option Explicit
Const BmkCCBmk As String = "CCBookmark" 'bookmark name
Const Pwd As String = "" 'Filling in Forms password

Sub PublicRecordsCombinedMacro()
'
' PublicRecordsCombinedMacro Macro
'
'
Application.ScreenUpdating = False
Dim Rng As Range, FmFld As FormField, i As Long
Set Rng = Selection.Range
With ActiveDocument
  Rng.Collapse wdCollapseStart
  'Dropdown Menu for Record Collection
  Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormDropDown)
  With FmFld
    .Name = "RecordsDD"
    .EntryMacro = ""
    .ExitMacro = "ConditionalContentPublicRecords"
    .Enabled = True
    With .DropDown.ListEntries
      .Add Name:="Record Collection"
      .Add Name:="U.S. Public Records Index"
      .Add Name:="United States Public Records 1970-2010"
    
    End With
  End With
  With Rng
    .End = FmFld.Range.End
    .InsertBefore """"
    .InsertAfter ","
    .Collapse wdCollapseEnd
  End With
  .Bookmarks.Add Name:=BmkCCBmk, Range:=Rng
  With Rng
    .End = FmFld.Range.End
    .Collapse wdCollapseEnd
  End With
  .Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=Pwd
  End With
  Set FmFld = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Sub ConditionalContentPublicRecords()
'
' ConditionalContent Macro
Application.ScreenUpdating = False
Dim Prot As Variant, BkMrkRng As Range, Rng As Range, FmFld As FormField
Dim StrFmt As String, CCBmk As Boolean
With ActiveDocument
  Prot = .ProtectionType
Application.ScreenUpdating = False
Select Case Selection.FormFields("RecordsDD").Result
Case "U.S. Public Records Index": CCBmk = True: StrFmt = " vol."
Case "United States Public Records 1970-2010": CCBmk = True: StrFmt = " database,"
Case Else: CCBmk = False: StrFmt = ""
End Select
If .ProtectionType <> wdNoProtection Then
    Prot = .ProtectionType
    .Unprotect
    'Update the bookmark referenced via BmkPopn
    Set BkMrkRng = .Bookmarks(CCBmk).Range
    If (CCBmk = True) And (Len(BkMrkRng.Text) = 0) Or _
      (CCBmk = False) And (Len(BkMrkRng.Text) <> 0) Then
      If (CCBmk = True) And (Len(BkMrkRng.Text) = 0) Then
        BkMrkRng.Text = ", "
      Else
        BkMrkRng.Delete
      End If
      .Bookmarks.Add CCBmk, BkMrkRng
    End If
    Select Case .FormFields("RecordsDD").Result
    
Case "U.S. Public Records Index"
If InStr(BkMrkRng.Text, ", vol. ") = 0 Then
          'Text & Formfield for volume
          With Rng
            .Text = StrFmt & ", vol. "
            .Collapse wdCollapseEnd
          End With
          Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
          FmFld.TextInput.EditType wdRegularText, "X"
          With Rng
    .Collapse wdCollapseEnd
    .InsertAfter ", "
    .End = FmFld.Range.End
    .Collapse wdCollapseEnd
    ' Ancestry Text and Viewing Record Date
    .InsertAfter " Ancestry (http://www.ancestry.com : viewed " & _
      Format(Now, "d MMMM yyyy") & "),"
    .Words(4).Font.Italic = True
    .Collapse wdCollapseEnd
    .InsertAfter ", entry for"
    'Name Form Field
  End With
    Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
    FmFld.TextInput.EditType wdRegularText, "Name"
    With Rng
    .Collapse wdCollapseEnd
    .InsertAfter ", "
    .End = FmFld.Range.End
    .Collapse wdCollapseEnd
    Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
    FmFld.TextInput.EditType wdRegularText, "Place"
    'Place Form Field
    With FmFld
    .Name = "Place"
    .EntryMacro = ""
    .ExitMacro = "UnlinkFields"
    .Enabled = True
    .TextInput.EditType Type:=wdRegularText, Default:="X", Format:="Title case"
    .TextInput.Width = 0
  End With
  'Additional Text
    With Rng
    .Collapse wdCollapseEnd
    .InsertAfter ", citing "" voter registration lists, public record filings, historical residential records, and other household database listings."""
    .End = FmFld.Range.End
    .Collapse wdCollapseEnd
    
    Select Case .FormFields("RecordsDD").Result

    
    Case "United States Public Records 1970-2010"
    If (InStr(BkMrkRng.Text, "database") = 0) Then
    With Rng
    .Text = StrFmt & ", database, "
    .Collapse wdCollapseEnd
    .InsertAfter "FamilySearch.org (https://www.familysearch.org/search/collection/2199956 : viewed " & _
    Format(Now, "d MMMM yyyy") & "), citing ""telephone directories, property tax assessments, credit applications, and other records available to the public,"" entry for """
    .Words(4).Font.Italic = True
    .Collapse wdCollapseEnd
    End With
    'Firstname Lastname Form Field
    Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
    With FmFld
    .Name = "FirstnameLastname"
    .EntryMacro = ""
    .ExitMacro = "UnlinkFields"
    .Enabled = True
    .TextInput.EditType Type:=wdRegularText, Default:="X", Format:="Title case"
    .TextInput.Width = 0
    End With
    With Rng
    .End = FmFld.Range.End
    .InsertAfter "."
    .Collapse wdCollapseEnd
    End With
    'Case Else: BkMrkRng.Text = ""
    End Select
    If Not FmFld Is Nothing Then BkMrkRng.End = FmFld.Range.End
    End If
    .Protect Type:=Prot, Password:=Pwd, NoReset:=True
  End If
End With
Set FmFld = Nothing: Set Rng = Nothing: Set BkMrkRng = Nothing
Application.ScreenUpdating = True
End Sub