Search for specific word in MSWord text and Drop-Down List, Name Iteratively

I have a word document which has drop down lists inserted in some parts of tables and main texts inside the document:


https://i.stack.imgur.com/hjUr2.png


I need to be able to search inside the document , including the drop down list options (whether the dropdown item is selected or not), for the phrase "INSERT" and "Select", and when either is found, replace them numerically with "Field 1" , "Field 2". For the numbering, 1 is the first found instance at the top of the document.
My main current issue is no advanced or basic "Find" function includes the dropdown lists in word, how can I search them? I initially tried to do lists separately, and got this far:

Code:

---

Sub LoadSchedule()
    Dim objCC As Integer
    Dim objCL As Integer
   
    For objCC = 1 To ActiveDocument.ContentControls.Count
    If ActiveDocument.ContentControls(objCC).Type = wdContentControlComboBox Or _
    ActiveDocument.ContentControls(objCC).Type = wdContentControlDropdownList Then
 
        For objCL = 1 To objCC.DropdownListEntries.Count
            ActiveDocument.ContentControls(objCC).DropdownListEntries(objCL).Select
         
            Selection.Find.ClearFormatting
            Selection.Find.Replacement.ClearFormatting

            'Here do the search inside selected area and name each found
            'area iterativley
        Next
    End If
    Next
End Sub

---

However Ideally the whole thing would be done in one loop, any and all help is appreciated.

Cross-posted at: https://answers.microsoft.com/en-us/...=1605166113653
Kindly read VBA Express' forum rules - which you agreed to when joining - especially on Cross-Posting & Multi-posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3

So in your example, you would want the second DDL List Entry to be changed to "INSERT Field 8" and and the third DDL List Entry changed to "to age Field 9" because there are at least 7 instances of SELECT occurring in the document before the DDL?

Why? What are you really wanting to do?

Quote:

---

Originally Posted by gmaxey

So in your example, you would want the second DDL List Entry to be changed to "INSERT Field 8" and and the third DDL List Entry changed to "to age Field 9" because there are at least 7 instances of SELECT occurring in the document before the DDL?

Why? What are you really wanting to do?

---

So this ties into a piece of Python code I am writing to be able to ingest documents that clients have filled in using this format (with variations, deleting some sections and adding some others) and finding corresponding sections, extract the keywords they entered under "INSERT" or "SELECT". As these will be scanned images, theres some ML involved which I do in python, but base step is naming the words I want extracted, so for example working from the top, the changes would be:

"Name" "FIELD_1 customer 'known as' name - delete for sole cases"
"Product" "FIELD_2 provider FEILD_3 policy type"
"FIELD_3" "FIELD_4"
"Term" "FIELD_5" (With drop down values replaced as "FIELD_6 years", "to age FIELD_7", Whole of life )

"This will FIELD_8 your need to FIELD_9 if FIELD_10, to help FIELD_11 your family or name meet FIELD_12 financial commitments and maintain FIELD_13 lifestyle."

I just don't have time right now to code this out, but if the issue is the CCs in the document then you might be able to process something like this:

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oCC As ContentControl
Dim lngIndex As Long
Dim lngLE As Long
  lngIndex = 1
  For Each oCC In ActiveDocument.Range.ContentControls
    If InStr(oCC.Range.Text, "Insert") > 0 Or InStr(oCC.Range.Text, "Select") > 0 Then
      oCC.Range.Text = Replace(oCC.Range.Text, "Insert", "Field_" & lngIndex)
      oCC.Range.Text = Replace(oCC.Range.Text, "Select", "Field_" & lngIndex)
      lngIndex = lngIndex + 1
      If oCC.Type = 3 Or oCC.Type = 4 Then
        For lngLE = 1 To oCC.DropdownListEntries.Count
          If InStr(oCC.DropdownListEntries(lngLE).Text, "Insert") > 0 Or InStr(oCC.DropdownListEntries(lngLE).Text, "Select") > 0 Then
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "Insert", "Field_" & lngIndex)
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "Select", "Field_" & lngIndex)
            oCC.DropdownListEntries(lngLE).Value = oCC.DropdownListEntries(lngLE).Text
            lngIndex = lngIndex + 1
          End If
        Next
      End If
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmaxey

I just don't have time right now to code this out, but if the issue is the CCs in the document then you might be able to process something like this:

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oCC As ContentControl
Dim lngIndex As Long
Dim lngLE As Long
  lngIndex = 1
  For Each oCC In ActiveDocument.Range.ContentControls
    If InStr(oCC.Range.Text, "Insert") > 0 Or InStr(oCC.Range.Text, "Select") > 0 Then
      oCC.Range.Text = Replace(oCC.Range.Text, "Insert", "Field_" & lngIndex)
      oCC.Range.Text = Replace(oCC.Range.Text, "Select", "Field_" & lngIndex)
      lngIndex = lngIndex + 1
      If oCC.Type = 3 Or oCC.Type = 4 Then
        For lngLE = 1 To oCC.DropdownListEntries.Count
          If InStr(oCC.DropdownListEntries(lngLE).Text, "Insert") > 0 Or InStr(oCC.DropdownListEntries(lngLE).Text, "Select") > 0 Then
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "Insert", "Field_" & lngIndex)
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "Select", "Field_" & lngIndex)
            oCC.DropdownListEntries(lngLE).Value = oCC.DropdownListEntries(lngLE).Text
            lngIndex = lngIndex + 1
          End If
        Next
      End If
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub

---

---

Thanks very much, tried to clean up without altering algorithm as wasn't doing anything when ran directly like this, however apparently it seems that if it finds more than one "SELECT" or insert inside a drop down list it renames them as the same with the current algorithm and throws this error :

"Run-time error 6215:
An entry with the same display name already exists - each entry must specify a display name"

I tried to add the counter of the found item in the naming as well to avoid, but faced a seperate error :

Code:

---

Sub HJ()
    Dim objCC As Integer 'ContentControl
    Dim lngIndex As Long
    Dim lngLE As Long
    Dim objCL As Integer 'ContentControlListEntry
    lngIndex = 1
   
    For objCC = 1 To ActiveDocument.Range.ContentControls.Count
        If InStr(ActiveDocument.ContentControls(objCC).Range.Text, "INSERT") > 0 Or InStr(ActiveDocument.ContentControls(objCC).Range.Text, "SELECT") > 0 Then
            ActiveDocument.ContentControls(objCC).Range.Text = Replace(ActiveDocument.ContentControls(objCC).Range.Text, "INSERT", "i_Field_" & objCC & "_" & lngIndex)
            ActiveDocument.ContentControls(objCC).Range.Text = Replace(ActiveDocument.ContentControls(objCC).Range.Text, "SELECT", "s_Field_" & objCC & "_" & lngIndex)
        lngIndex = lngIndex + 1
   
            If ActiveDocument.ContentControls(objCC).Type = wdContentControlComboBox Or _
            ActiveDocument.ContentControls(objCC).Type = wdContentControlDropdownList Then
              For lngLE = 1 To ActiveDocument.ContentControls(objCC).DropdownListEntries.Count
                  If InStr(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text, "INSERT") > 0 Or InStr(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text, "SELECT") > 0 Then
                      ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text = Replace(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text, "INSERT", "ii_Field_" & lngLE & "_" & lngIndex)
                      ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text = Replace(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text, "SELECT", "ss_Field_" & lngLE & "_" & lngIndex)
                      ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Value = ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text
                      lngIndex = lngIndex + 1
                  End If
              Next
            End If
        End If
    Next
End Sub

---

However then face error on "Range cannot be deleted" , I am not sure how to treat the range areas....

You are just gonna have to tinker with it. You probably will need to set the placeholder text as well:

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oCC As ContentControl
Dim lngIndex As Long
Dim lngLE As Long
Dim lngType As Long
Dim bConvert As Boolean
  lngIndex = 1
  For Each oCC In ActiveDocument.Range.ContentControls
    bConvert = False
    If InStr(oCC.Range.Text, "INSERT") > 0 Or InStr(oCC.Range.Text, "SELECT") > 0 Then
      If oCC.Type = 3 Or oCC.Type = 4 Then lngType = oCC.Type: oCC.Type = 1: bConvert = True
      oCC.Range.Text = Replace(oCC.Range.Text, "INSERT", "Field_" & lngIndex)
      oCC.Range.Text = Replace(oCC.Range.Text, "SELECT", "Field_" & lngIndex)
      lngIndex = lngIndex + 1
      If bConvert Then oCC.Type = lngType
    End If
    If oCC.Type = 3 Or oCC.Type = 4 Then
      For lngLE = 2 To oCC.DropdownListEntries.Count
        If InStr(oCC.DropdownListEntries(lngLE).Text, "INSERT") > 0 Or InStr(oCC.DropdownListEntries(lngLE).Text, "SELECT") > 0 Then
          If InStr(oCC.DropdownListEntries(lngLE).Text, "INSERT") > 0 Then
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "INSERT", "Field_" & lngIndex)
          End If
          If InStr(oCC.DropdownListEntries(lngLE).Text, "SELECT") > 0 Then
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "SELECT", "Field_" & lngIndex)
          End If
          oCC.DropdownListEntries(lngLE).Value = oCC.DropdownListEntries(lngLE).Text
          lngIndex = lngIndex + 1
        End If
      Next
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmaxey

I just don't have time right now to code this out, but if the issue is the CCs in the document then you might be able to process something like this:

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oCC As ContentControl
Dim lngIndex As Long
Dim lngLE As Long
  lngIndex = 1
  For Each oCC In ActiveDocument.Range.ContentControls
    If InStr(oCC.Range.Text, "Insert") > 0 Or InStr(oCC.Range.Text, "Select") > 0 Then
      oCC.Range.Text = Replace(oCC.Range.Text, "Insert", "Field_" & lngIndex)
      oCC.Range.Text = Replace(oCC.Range.Text, "Select", "Field_" & lngIndex)
      lngIndex = lngIndex + 1
      If oCC.Type = 3 Or oCC.Type = 4 Then
        For lngLE = 1 To oCC.DropdownListEntries.Count
          If InStr(oCC.DropdownListEntries(lngLE).Text, "Insert") > 0 Or InStr(oCC.DropdownListEntries(lngLE).Text, "Select") > 0 Then
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "Insert", "Field_" & lngIndex)
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "Select", "Field_" & lngIndex)
            oCC.DropdownListEntries(lngLE).Value = oCC.DropdownListEntries(lngLE).Text
            lngIndex = lngIndex + 1
          End If
        Next
      End If
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub

---

---

So I edited further, trying different find and replace methods to avoid the range error, and final result is this:

Attachment 27444

Some Selects are replaced, as are some Inserts, however some are randomly missed - I cannot figure how it catches some and misses others, maybe there's a problem with my counter? My latest code in updated bellow :

Code:

---

Option Explicit
Sub HJ()
    Dim objCC As Integer 'ContentControl
    Dim lngIndex As Long
    Dim lnkIndex As Long
    Dim lngLE As Long
    Dim objCL As Integer 'ContentControlListEntry
    lngIndex = 1
    lnkIndex = 1


    For objCC = 1 To ActiveDocument.Range.ContentControls.Count
        If InStr(ActiveDocument.ContentControls(objCC).Range.Text, "INSERT") > 0 Or InStr(ActiveDocument.ContentControls(objCC).Range.Text, "SELECT") > 0 Then
       
        With ActiveDocument.ContentControls(objCC).Range.Find
            .ClearFormatting
            .Text = "INSERT"
            .Replacement.Text = "i_Field_" & objCC & "_" & lngIndex
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Execute Replace:=wdReplaceOne
        End With
        With ActiveDocument.ContentControls(objCC).Range.Find
            .ClearFormatting
            .Text = "SELECT"
            .Replacement.Text = "s_Field_" & objCC & "_" & lngIndex
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Execute Replace:=wdReplaceOne
        End With
        lngIndex = lngIndex + 1
   
            If ActiveDocument.ContentControls(objCC).Type = wdContentControlComboBox Or _
            ActiveDocument.ContentControls(objCC).Type = wdContentControlDropdownList Then
              For lngLE = 1 To ActiveDocument.ContentControls(objCC).DropdownListEntries.Count
                  If InStr(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text, "INSERT") > 0 Or InStr(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text, "SELECT") > 0 Then
                      ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text = Replace(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text, "INSERT", "ii_Field_" & lngLE & "_" & lngIndex)
                      ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Value = ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text
                      lngIndex = lngIndex + 1
                      lnkIndex = lnkIndex + 1
                  End If
              Next
            End If
        End If
    Next
End Sub

---

Perhaps:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
Dim CCtrl As ContentControl, bFld As Boolean, i As Long, j As Long
For Each CCtrl In ActiveDocument.ContentControls
  bFld = False
  With CCtrl
    If InStr(1, .PlaceholderText.Value, "SELECT", vbTextCompare) > 0 Then
      bFld = True: i = i + 1:
      .SetPlaceholderText Text:=Replace(.PlaceholderText.Value, "SELECT", "Field_" & i, , , vbTextCompare)
    ElseIf InStr(1, .PlaceholderText.Value, "INSERT", vbTextCompare) > 0 Then
      bFld = True: i = i + 1:
      .SetPlaceholderText Text:=Replace(.PlaceholderText.Value, "INSERT", "Field_" & i, , , vbTextCompare)
    End If
    Select Case .Type
      Case wdContentControlRichText, wdContentControlText
        If InStr(1, .Range.Text, "SELECT", vbTextCompare) > 0 Then
          If bFld = False Then
            bFld = True: i = i + 1
          End If
          .Range.Text = Replace(.Range.Text, "SELECT", "Field_" & i, , , vbTextCompare)
        ElseIf InStr(1, .Range.Text, "INSERT", vbTextCompare) > 0 Then
          If bFld = False Then
            bFld = True: i = i + 1
          End If
          .Range.Text = Replace(.Range.Text, "INSERT", "Field_" & i, , , vbTextCompare)
        End If
      Case wdContentControlDropdownList, wdContentControlComboBox
        For j = 1 To .DropdownListEntries.Count
          If InStr(1, .DropdownListEntries(j).Text, "SELECT", vbTextCompare) > 0 Then
            If bFld = False Then
              bFld = True: i = i + 1
            End If
            .DropdownListEntries(j).Text = Replace(.DropdownListEntries(j).Text, "SELECT", "Field_" & i, , , vbTextCompare)
          ElseIf InStr(1, .DropdownListEntries(j).Text, "INSERT", vbTextCompare) > 0 Then
            If bFld = False Then
              bFld = True: i = i + 1
            End If
            .DropdownListEntries(j).Text = Replace(.DropdownListEntries(j).Text, "INSERT", "Field_" & i, , , vbTextCompare)
          End If
        Next
    End Select
  End With
Next
Application.ScreenUpdating = True
End Sub

---

Thanks Paul, I tried above, at the line "With CCtrl" I encounter a runtime error 91, mentioning that the with block variable has not been set, I tried looking at solutions and apparently I need to use the Set function to assign something to the CCtrl variable , do you have any suggestions?

I literally copy and pasted it, here's a screenshot:

Attachment 27446

Could it be a version issue?

Quote:

---

Originally Posted by gmaxey

You are just gonna have to tinker with it. You probably will need to set the placeholder text as well:

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oCC As ContentControl
Dim lngIndex As Long
Dim lngLE As Long
Dim lngType As Long
Dim bConvert As Boolean
  lngIndex = 1
  For Each oCC In ActiveDocument.Range.ContentControls
    bConvert = False
    If InStr(oCC.Range.Text, "INSERT") > 0 Or InStr(oCC.Range.Text, "SELECT") > 0 Then
      If oCC.Type = 3 Or oCC.Type = 4 Then lngType = oCC.Type: oCC.Type = 1: bConvert = True
      oCC.Range.Text = Replace(oCC.Range.Text, "INSERT", "Field_" & lngIndex)
      oCC.Range.Text = Replace(oCC.Range.Text, "SELECT", "Field_" & lngIndex)
      lngIndex = lngIndex + 1
      If bConvert Then oCC.Type = lngType
    End If
    If oCC.Type = 3 Or oCC.Type = 4 Then
      For lngLE = 2 To oCC.DropdownListEntries.Count
        If InStr(oCC.DropdownListEntries(lngLE).Text, "INSERT") > 0 Or InStr(oCC.DropdownListEntries(lngLE).Text, "SELECT") > 0 Then
          If InStr(oCC.DropdownListEntries(lngLE).Text, "INSERT") > 0 Then
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "INSERT", "Field_" & lngIndex)
          End If
          If InStr(oCC.DropdownListEntries(lngLE).Text, "SELECT") > 0 Then
            oCC.DropdownListEntries(lngLE).Text = Replace(oCC.DropdownListEntries(lngLE).Text, "SELECT", "Field_" & lngIndex)
          End If
          oCC.DropdownListEntries(lngLE).Value = oCC.DropdownListEntries(lngLE).Text
          lngIndex = lngIndex + 1
        End If
      Next
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub

---

---

Thanks greg, I have been tinkering - similar to response I posted after your last post, the "Range cannot be deleted" error pops up when the replacement is happening inside "oCC.Range.Text = Replace(oCC.Range.Text, "INSERT", "Field_" & lngIndex)" , do you have any ideas?

Why don't you send me two documents. One with the a few CCs in the current state and one with a few CCs in the state you want it to be after the process is run. I will try to see if I can make it work. I am not hard to get in contact with. Just use the feedback link on my website.

Best Regards,
Greg Maxey

Success is the ability to go from failure to failure without losing your enthusiasm.
~ Sir Winston Churchill

Quote:

---

Originally Posted by elnaz_sn

Thanks Paul, I tried above, at the line "With CCtrl" I encounter a runtime error 91, mentioning that the with block variable has not been set, I tried looking at solutions and apparently I need to use the Set function to assign something to the CCtrl variable
...
I literally copy and pasted it, here's a screenshot:
...
Could it be a version issue?

---

There is no need to use SET - the code is ready to run as is.

The code isn't version-specific.

If you're getting errors, that would only be because:
• you have a faulty Office installation;
• you're trying to run it from an application other than Word; or
• you're trying to run it in Word 2003 or earlier.