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

[elnaz_sn]

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 (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:



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.

[macropod]

Cross-posted at: https://answers.microsoft.com/en-us/msoffice/forum/all/vba-search-for-specific-word-in-msword-text-and/e5b5ef58-1a92-47b6-9e5d-7ad323997181?rtAction=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.php?faq=new_faq_item#faq_new_faq_item3

[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?

[elnaz_sn]

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."

[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:


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

[elnaz_sn]

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:


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 :


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).Te xt, "INSERT", "ii_Field_" & lngLE & "_" & lngIndex)
ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Text = Replace(ActiveDocument.ContentControls(objCC).DropdownListEntries(lngLE).Te xt, "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....

[gmaxey]

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


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

[elnaz_sn]

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:


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:

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 :


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).Te xt, "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

[macropod]

Perhaps:

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

[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 , do you have any suggestions?

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

27446

Could it be a version issue?

[elnaz_sn]

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


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?

[gmaxey]

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

[macropod]

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.