Consulting

Results 1 to 13 of 13

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

  1. #1

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





    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.
    Last edited by elnaz_sn; 11-11-2020 at 04:05 PM. Reason: readability

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,174
    Location
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,247
    Location
    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?
    Greg

    Visit my website: http://gregmaxey.com

  4. #4
    Quote Originally Posted by gmaxey View Post
    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."
    Last edited by elnaz_sn; 11-12-2020 at 04:19 PM. Reason: readability

  5. #5
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,247
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  6. #6
    Quote Originally Posted by gmaxey View Post
    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).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....

  7. #7
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,247
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  8. #8
    Quote Originally Posted by gmaxey View Post
    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:

    res3.jpg

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

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,174
    Location
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  10. #10
    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:

    Untitled.jpg

    Could it be a version issue?
    Attached Images Attached Images
    Last edited by macropod; 11-19-2020 at 02:39 PM. Reason: Trimmed & merged posts

  11. #11
    Quote Originally Posted by gmaxey View Post
    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?

  12. #12
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,247
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  13. #13
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,174
    Location
    Quote Originally Posted by elnaz_sn View Post
    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.
    Last edited by macropod; 11-19-2020 at 02:40 PM. Reason: Edited to match merged posts @ #10
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •