Filling out Text in Excel Cell Based on Highlighted Text in Microsoft Word

[Fromlostdays1]

I've moderately altered some code I found online for my purposes, as follows.

From Within Excel the code does the follow:

1. Use a command button to open a file explorer
2. Allow me to select a Word document (manually)
3. Open Word Document and Make it Visible
4. Automatically Find Specific Text
5. Move Cursor below that text and highlight all of the text on that line
6. Paste that text into a specific cell in Excel

Here the Code:

Dim FName As String, FD As FileDialog
Dim WApp As Object, WDoc As Object, WDR As Object
Dim ExR As Range
Dim colnum1 As String
colnum1 = Range("H4").Value

    Set ExR = Selection ' current location in Excel Sheet

    'let's select the WORD doc
    Set FD = Application.FileDialog(msoFileDialogOpen)
    FD.Show
    If FD.SelectedItems.Count <> 0 Then
        FName = FD.SelectedItems(1)
    Else
        Exit Sub
    End If

    ' open Word application and load doc
    Set WApp = CreateObject("Word.Application")
    WApp.Visible = True
    Set WDoc = WApp.Documents.Open(FName)

    ' go home and search
    WApp.Selection.HomeKey Unit:=6
    WApp.Selection.Find.ClearFormatting
    WApp.Selection.Find.Execute "(SEARCH TERM HERE)"

    ' move cursor from find to final data item
    WApp.Selection.MoveDown Unit:=5, Count:=1
    

    ' the miracle happens here
    ActiveDocument.Bookmarks("\line").Select

    ' grab and put into excel
    Set WDR = WApp.Selection
    Range(colnum1 & "12") = WDR 'place at Excel cursor
    
    End Sub

Everything works perfectly. However, what I need to do now is beyond me, and has everything to do with number 6 in that list: "Paste that text into a specific cell in Excel"
Instead of just pasting the text that's selected in Word at this stage, I need Excel to somehow read it and paste not that specific text, but a text I define based on it.

Example
The Search term be "Elevators" and below that in Word either the word "Yes" or the word "No" appears.
So I know I need and If Then statement, but I also need it to, instead of copying "yes" or "no" directly, put the words "Required" if Yes is in Word, or "Not Required" if No is in Word.

This is what I came up with, and remember this is just replacing the last paragraph of code:

' grab and put into excel

Set WDR = WApp.Selection
If WDR = Yes Then 'where Yes is the text that has been highlighted in Word
Range(colnum1 & "12") = Required 'place at Excel cursor
End If
If WDR = No Then 'where No is the text that has been highlighted in Word
Range(colnum1 & "12") = Required 'place at Excel cursor
End If

But this is not working. Do I need to somehow Dim the highlighted text in Word as a string?

Any help is greatly appreciated.

Thanks!

 

[NdNoviceHlp]

Hi Fromlostdays1. I don't really understand how your code makes the "miracle happen" but you can trial this code to see if it works for you. HTH. Dave

Set WDR = WApp.Selection
If WDR.Range.Text = "Yes" Then 'where Yes is the text that has been highlighted in Word
ActiveSheet.Range(colnum1 & "12") = "Required" 'place at Excel cursor
End If
If WDR.Range.Text = "No" Then 'where No is the text that has been highlighted in Word
ActiveSheet.Range(colnum1 & "12") = "Not Required" 'place at Excel cursor
End If

 

[Fromlostdays1]

Hi Dave!

Most of the commented out stuff came from the original coder, including the miracle line. I just left it in. I should probably remove "replace at excel cursor" too since that's not what it does anymore. haha

The above code does not error out, however, it's not putting any text at all in the Excel cell. I suspect because my code has to highlight the entire line *ActiveDocument.Bookmarks("\line").Select* which I have to use because I'm running this a lot and not all text is yes and no, that it's maybe grabbing spaces or something at the end of the line. Rather than diagnose that though, I do have an idea as a workaround, if you're in a giving mood.

Instead of replacing step 6
' grab and put into excel
Set WDR = WApp.Selection
Range(colnum1 & "12") = WDR 'place at Excel cursor

could I instead just add a step 7 in the code that searches the specific cell for "yes" (instead of trying to read it from the Word doc) and replaces it there with "Required"?

Maybe something like

Select Case Range(colnum1 & "12").Value
Case "Yes"
(code to replace value with "Required")
Case "No"
(code to replace value with "Not Required")

Do you think that would work and what the code to replace the text after the fact would be? Would that be range.replace?

Thanks!

 

[NdNoviceHlp]

So your posted code actually puts "Yes" or "No" in the correct cell already? I don't really understand your code. You find (select) some search item, then move down to the end of something and then select a bookmark which contains something that you're interested in. Why not just find the bookmark and get it's contents?

If Activesheet.Range(colnum1 & 12).Value = "Yes" then
Activesheet.Range(colnum1 & 12).Value = "Required"
Else
Activesheet.Range(colnum1 & 12).Value = "Not Required"
End if

Except...

colnum1 = Range("H4").Value"

What's in Range("H4").Value? If it's not a letter, I'm guessing that's why my previous post had no output... that and the number 12 should not have quotation marks (my bad).
Dave

 

[Fromlostdays1]

It may have been the quotation marks.

If Activesheet.Range(colnum1 & 12).Value = "Yes" then
Activesheet.Range(colnum1 & 12).Value = "Required"
Else
Activesheet.Range(colnum1 & 12).Value = "Not Required"
End if

This works perfectly, though, and will do exactly what I need. Thank you so much. To be completely forthcoming, I don't fully understand the code either. I know just enough to google, and I've been at it for a while now so I am picking things up, but most of the code I have is a hodge podge of other people's code.

To answer your questions,

Yes, the original posted code works as intended, but it could only paste whatever was found in the Word directly. I set it to search for the title "Elevators" and then move the cursor one row down to the coverage, and then highlight that entire line.

The word doc might look like:

Elevators
Yes

However, what I needed to actually populate in the Excel Cell isn't "Yes", but "Required." And I needed it to be able to do the same if "No" was in the word document, which is what you helped me with. There are no bookmarks in the Word document. I got that line right out a google search when trying to get it to highlight the entire line containing "Yes". But it does work.

You asked what is in H4. So I'm actually proud of this. I made a nice looking spreadsheet with freeze panes, because there's columns and columns (hundreds of columns) of data I need to populate. You can see why I started trying to teach myself VBA haha. And by using:

Dim colnum1 As String
colnum1 = Range("H4").Value

and then:
Activesheet.Range(colnum1 & 12).Value =

I can actually define the column I want the output to be in on the fly, and obviously the 12 in this case is the row. So in the cell H4 which is in the frozen part of my spreadsheet, I can put any column letter and all the code will populate the data directly into that column. It's been meticulous and there is a lot of code and no doubt actual coders could have done it better and easier, but I'm excited to be getting there!

Thanks again for you help!

 

[NdNoviceHlp]

I had to find out what makes it tick. The find selects the "Elevator". The MoveDown Unit:=5, Count:=1 moves the selection down 1 line (5 is the Word constant for line). The Bookmarks("\line") is a predefined bookmark (that I didn't know existed) which is the "Current line or the first line of the current selection. If the insertion point is at the end of a line that is not the last line in the paragraph, the bookmark includes the entire next line." "Use these predefined bookmarks just as you use bookmarks that you place in documents, except that you don't have to set them" So I guess the "miracle" is that you can infer a bookmark at your current document selection. From the inferred bookmark you can get the selection contents. If it's a bookmark then usually to get the contents...

BookmarkText = ActiveDocument.Bookmarks("BookMarkName").Range.Text

whereas your code makes the inferred bookmark a selection and somehow produces text output from a declared object... a miracle

Dim WDR As Object
Set WDR = WApp.Selection
Range(colnum1 & 12) = WDR

You are welcome for the assistance. Thank you for posting your outcome. Perhaps others can provide some enlightenment on how this miracle happens as I don't have a full understanding of what's going on. Dave