Word VBA to search for bold text within a table

OfficeAssociate99 · #1 06-19-2017, 07:27 AM

Hi guys,
I'm a newcomer to VBA, so I'm sorry if the formatting is nonstandard. I trying to write a code that finds bold text within all rows of a table (NOT cells OR columns). Then, if the text is a series of known values, then it moves into the next row. If it is not, then the program should recognize this. Right now, I seem to be stuck in an infinite loop, but even before that, it would not return the values I am was looking for.

Code:

 
Dim rw1 As Object
Dim G As Integer
For i = 1 To ActiveDocument.Tables(1).Rows.Count
  
   Set rw1 = ActiveDocument.Tables(1).Rows(1).Range
    With rw1
    With .Find
        With .Font
            .Bold = True
        End With
        .Text = ""
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .Execute
         Do While .Execute
            Set rw1 = ActiveDocument.Tables(1).Rows(i).Next
            If Selection.Find.Font.Bold = True Then
              If Selection.Find.Text = "Organization" Or Selection.Find.Text = "Date" Or Selection.Find.Text = "Description" Or Selection.Find.Text = "Aerospace, Space & Defence" Or Selection.Find.Text = "Automotive" Or Selection.Find.Text = "Manufacturing" Or Selection.Find.Text = "Life Sciences" Or Selection.Find.Text = "Information Communication Technologies / Digital" Or "Natural Resources / Energy" Or Selection.Find.Text = "Regional Stakeholders" Or Selection.Find.Text = "Other Policy Priorities" Then
                G = 5
               Else
                    Selection.Collapse Direction:=wdCollapseStart
                    Selection.MoveDown Unit:=wdLine, Count:=1
                    rng.SetRange Start:=Selection.Start, End:=ActiveDocument.Range.End
                    rng.Select
                    With Selection.Find
                        With .Font
                            .Bold = True
                        End With
                        .Text = "Aerospace, Space & Defence" Or "Automotive" Or "Manufacturing" Or "Life Sciences" Or "Information Communication Technologies / Digital" Or "Natural Resources / Energy" Or "Regional Stakeholders" Or "Other Policy Priorities"
                        .MatchCase = True
                        .MatchWholeWord = True
                        If Selection.Find = True Then
                         MsgBox ("A category has been inserted into the middle of the document. Please copy manually or move extra category to the end of the document to continue automation.")
                            Exit Sub
                        ElseIf Selection.Find.Font.Bold = True Then
                         MsgBox ("There is more than one extra category. Please copy manually.")
                            Exit Sub
                        Else
                            rng.Select
                            Selection.Copy
                            ThisDocument.Activate
                            ThisDocument.Tables(1).Columns(1).Select
                            Selection.Collapse Direction:=wdCollapseEnd
                            Selection.PasteAndFormat (wdTableInsertAsRows)
                        End If
                    End With
              End If
            Else
            G = 6
           End If
     Loop
   End With
   End With
Next i

slaycock · #2 06-19-2017, 12:25 PM

I'm afraid your code does have a lot of errors both structural and logical so it would never work as you intended.

What do you want to happen if no bold text with a key term is found in a row?

What do you want to happen if a key term in bold is found?

Some hints are

1. Use F1 to get help on any VBA term
2. In the IDE use Tools.options and tick all the boxes under Code Settings

The code below might help to point you in the right direction

Code:

Sub sbSearchRowsForBold()

' Consolidate into a single string so we can search using instring  to check if the found text is a Key Term
' If Selection.Find.Text = "Organization" Or Selection.Find.Text = "Date" Or Selection.Find.Text = "Description" Or Selection.Find.Text = "Aerospace, Space & Defence" Or Selection.Find.Text = "Automotive" Or Selection.Find.Text = "Manufacturing" Or Selection.Find.Text = "Life Sciences" Or Selection.Find.Text = "Information Communication Technologies / Digital" Or "Natural Resources / Energy" Or Selection.Find.Text = "Regional Stakeholders" Or Selection.Find.Text = "Other Policy Priorities" Then
' Some of the text entries include ',' so + is used as a separator
Const myKeyTerms            As String = _
    "OrganizationDate+Description+Aerospace, Space & Defence+Automotive+Manufacturing+Life Sciences+Information Communication Technologies / Digital+Natural Resources / Energy+Regional Stakeholders+Other Policy Priorities"

Dim myTable                 As Table
Dim myRow                   As Row
Dim myRange                 As Range

    For Each myTable In ActiveDocument.Tables
        For Each myRow In myTable.Rows
            ' If successful myrange is moved to the found text
            Set myRange = myRow.Range
            ' Search parameters are persistent so you only need to change them if the search parameters change
            With myRange.Find
                .Font.Bold = True
                .Text = ""
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .Wrap = wdFindStop
                .Forward = True
                ' Stop when the range is searched
                ' .Execute returns true if the search is found
                Do While .Execute
                    ' myRange is now the found term
                    Debug.Print "Bold text is found ->" & myRange.Text
                    ' for learning purposes the select statement below shows the new range for myrange
                    myRange.Select
                    If InStr(myKeyTerms, myRange.Text) > 0 Then
                        'Actions to do if the row contained a key term in bold
                        Debug.Print "Found a key term in bold " & myRange.Text
                        ' Continue searching
                        
                    Else
                        'Actions to do is the row does not contain bold text
                        Debug.Print "No key terms found in bold text"
                    End If
                    ' now we need to reset myRange to encompass the rest of the row
                    myRange.Start = myRange.End + 1
                    myRange.End = myRow.Range.End
                    ' again for learning see where myRange has moved
                    myRange.Select
                Loop
            End With
        Next myRow
    Next myTable
End Sub

Good luck with your reading

OfficeAssociate99 · #3 06-19-2017, 12:37 PM

Thanks for your help, and I will look into the key terms. Could you give me a bit more background on the logical/technical errors that are within my code (for future reference)? As for what I want to happen, here are the basics:

1. If bold text is not found within a row, then it moves onto the next row.
2. If bold text is found, the code checks it against a predefined list of names.
3. If the bold text is within the predefined list of names, then it moves into the next row.
4. If the bold text is not in the list of predefined names, then the program checks to see if bold text with the predefined names appears after the non-predefined bold text.
5. If bold text does not appear after the non-predefined bold text, then it selects and copies everything from the beginning of the bold text to the end of the table.
6. If bold text with one of the predefined names appears after the non-predefined bold text, then the program would preferably select and copy all the rows in between the two bold rows (including the row with the non-predefined bold text), or else return a msg box that says something along the lines of "there is an extra category within the document".

Hopefully that wasn't too confusing.

EDIT 1:
I ran your code through my computer, but it crashed word. It could be that my computer isn't powerful enough to successfully run the code...thoughts?

slaycock · #4 06-19-2017, 01:06 PM

Quote:

1. If bold text is not found within a row, then it moves onto the next row.
2. If bold text is found, the code checks it against a predefined list of names.
3. If the bold text is within the predefined list of names, then it moves into the next row.
4. If the bold text is not in the list of predefined names, then the program checks to see if bold text with the predefined names appears after the non-predefined bold text.
5. If bold text does not appear after the non-predefined bold text, then it selects and copies everything from the beginning of the bold text to the end of the table.
6. If bold text with one of the predefined names appears after the non-predefined bold text, then the program would preferably select and copy all the rows in between the two bold rows (including the row with the non-predefined bold text), or else return a msg box that says something along the lines of "there is an extra category within the document".

You are trying to describe an algorithm rather than what you want to happen.

1. Check
2. Check Your predefined list of names is the string assigned to myKeyTerms
3. At the moment we continue searching the row
4. You now need a flag to say you found bold text but it wasn't a key term
5. OK if the bold text isn't a key term we copy something. Do you really mean end of table or end of row?
6 now you are losing me.

Code:

 Could you give me a bit more background on the logical/technical errors that are within my code (for future reference)?

There would be a lot of comments. I don't want to be rude but the main problem is that you don't really seem to have a grasp of VBA and the Word object model.

The best recommendation would be to get yourself a good book on VBA and start reading.

OfficeAssociate99 · #5 06-19-2017, 01:14 PM

Regarding the errors, that is understandable. I am entirely self-taught when it comes to VBA, so while I have a fairly decent grasp of some concepts, there are definitely large holes in my knowledge.
As for 5 and 6, let me explain a little more what I am trying to do.

Basically, information is submitted each week. I would like to automate the process. Each category (the predefined names) has a varying number of rows each week. However, sometimes information does not fit into the predefined categories, so the people that submit the information add a category (category titles are the only things in bold in the document). I want to be able to tell if a category is added, and here is were things get a little complicated.

If it is after all the predefined categories, then it is safe to copy and paste everything below the category (as I will not be duplicating data). However, if they inserted in between the predefined categories, selecting everything after will duplicate data. To avoid this, I either want to a) copy and paste all the data in between the new and predefined categories, or if that is not possible b) tell the user that they need to move the data manually.

slaycock · #6 06-19-2017, 01:32 PM

So if I understand correctly you have

1 Defined category
2 Data row
3 Data row
4 Data row
5 Undefined category
6 Data row
7 Data row
8 Data row
9 Defined category
10 Data row
11 Data row
12 Data row

and you want to identify instances such as rows 5-8 and move them elsewhere.

OfficeAssociate99 · #7 06-19-2017, 01:37 PM

Yes, you've captured the essence of the problem (more or less). I want to identify instances of undefined categories, period. If it occurs like this:

1 Defined Category
2 Data Row
3 Data Row
4 Defined Category
5 Data Row
6 Data Row
7 Undefined Category
8 Data Row

Then I just want to copy everything in rows 7 - 8 (or the end of the document).

If it occurs like you presented it:

1 Defined category
2 Data row
3 Data row
4 Data row
5 Undefined category
6 Data row
7 Data row
8 Data row
9 Defined category
10 Data row
11 Data row
12 Data row

Then I want to select rows 5-8 and copy them.

Hope that helps, and thank you for taking the time to help me out

slaycock · #8 06-20-2017, 01:06 AM

The code below is closer to your intent.

Code:

Sub sbSearchRowsForBold()

' Consolidate into a single string so we can search using instring  to checkif the found text is a Key Term
' If Selection.Find.Text = "Organization" Or Selection.Find.Text = "Date" Or Selection.Find.Text = "Description" Or Selection.Find.Text = "Aerospace, Space & Defence" Or Selection.Find.Text = "Automotive" Or Selection.Find.Text = "Manufacturing" Or Selection.Find.Text = "Life Sciences" Or Selection.Find.Text = "Information Communication Technologies / Digital" Or "Natural Resources / Energy" Or Selection.Find.Text = "Regional Stakeholders" Or Selection.Find.Text = "Other Policy Priorities" Then
' Some of the text entries include ',' so + is used as a seperator
Const myKeyTerms            As String = _
    "OrganizationDate+Description+Aerospace, Space & Defence+Automotive+Manufacturing+Life Sciences+Information Communication Technologies / Digital+Natural Resources / Energy+Regional Stakeholders+Other Policy Priorities"

Dim myTable                 As Table
Dim myFirstRange            As Range
Dim mySecondRange           As Range
Dim myRemoveRange           As Range

    For Each myTable In ActiveDocument.Tables
        Set myFirstRange = Nothing
        Do
            If myFirstRange Is Nothing Then
                Set myFirstRange = fnFindBold(mySearchRange:=myTable.Range.Rows(1).Range)
            Else
                Set myFirstRange = fnFindBold(mySearchRange:=myFirstRange.Next(unit:=wdRow))
            End If
            ' two possible cases for myFirstrange
            ' 1. a found range
            ' 2. nothing - which means we have searched the whole table.
            If Not myFirstRange Is Nothing Then
                If InStr(myKeyTerms, myFirstRange.Text) = 0 Then
                    ' Found bold text that is not a defined category (key term)
                    Set mySecondRange = myFirstRange.Duplicate
                    Do
                        Set mySecondRange = fnFindBold(mySecondRange.Next(unit:=wdRow))
                    Loop Until InStr(myKeyTerms, mySecondRange) > 0
                    'We have now found text that is a defined category key term
                    Set myRemoveRange = myFirstRange.Duplicate
                    myRemoveRange.End = mySecondRange.Previous(unit:=wdRow).End
                    Set myFirstRange = mySecondRange
                    myRemoveRange.Select
                    myRemoveRange.Cut
                    ' the destiny of the cut text is left to the requirements of the user
                End If
            End If
        Loop Until myFirstRange Is Nothing
            
    Next myTable
    
End Sub

Function fnFindBold(ByVal mySearchRange As Range) As Range

    If mySearchRange Is Nothing Then
        Set fnFindBold = Nothing
        Exit Function
    End If
    
    With mySearchRange.Find
            .Font.Bold = True
            .Text = ""
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .Wrap = wdFindStop
            .Forward = True
            .Execute
            If .Found Then
                Set fnFindBold = mySearchRange
            Else
                Set fnFindBold = fnFindBold(mySearchRange.Next(unit:=wdRow))
            End If
    End With
End Function

Key things to note are

1. Ranges are pointers to objects so 'set range2=range1' does not create a new range object, it just creates a second pointer to the same object as pointed to by range1. if you want to create a second object for range2 then you must use the duplicate property 'set range2=range2.duplicate'. You might think that you could also say 'set range2 = new range1' but this is not the case.

2. Searching for bold text is a repeated task so it is delegated to a function.

3. fnFindBold is written as a recursive function. You could rewrite this using a do loop.

4. If we ask for the next row in a table and there isn't a next row then 'nothing' is returned and not the range corresponding to the first row of the next table.

5. The code above searches by row, but this possibly isn't necessary.

I tested the code above on the table

OrganizationDate
2 Data row
3 Data row
4 Data row
User defined category
6 Data row
7 Data row
8 Data row
Life Sciences
10 Data row
11 Data row
12 Data row

and it correctly identifies and cuts the text from 'User defined category' to '8 Data row' from the table.

I've left it to your imagination as to what you do with the rows that have been cut from the table.

OfficeAssociate99 · #9 06-20-2017, 07:47 AM

Hey man, this amazing, thanks for all your help. It works (almost) as intended with one exception. Every time I run it, I get runtime error 91 on this line:

Code:

Loop Until InStr(myKeyTerms, mySecondRange) > 0

However, if I add a non-defined category, then it works as intended (cuts the category) before once again returning runtime error 91 "object not defined"
Any ideas? I'm running some basic tests, but I'm sure you have a much better idea of possible causes...

EDIT 1:
I think I've figured it out. If an undefined category is inserted at the end, the code outputs an error, because there is no defined category to use as a reference against.

EDIT 2:
I think I have a solution - I changed the line to this:

Code:

Loop Until InStr(myKeyTerms, mySecondRange) > 0 Or myFirstRange Is Nothing

I'll run a few more tests, but the end is sight! Thanks again

slaycock · #10 06-20-2017, 08:29 AM

An undefined category at the end of the document is an edge case I didn't consider.

But there is also a serendipitous error.

Loop Until InStr(myKeyTerms, mySecondRange)

should actually be

Loop Until InStr(myKeyTerms, mySecondRange.Text)

BUT the default property fpr the range object is text therefore the two statements above are syntactivally the same (you don't need to use the default property name to get the value).

That leaves an issue as its not possible now to use range.text a the loop terminator is the range can be nothing.

To get around this we need to move the tests for ending the loop inside the do loop so we can do each test separately and then use a separate boolean variable as a flag to end the loop.

We also need to handle the case of mySecondRange = nothing to ensure that the outer do loop ends correctly, hence the addition of the if statements after the end of the innder loop.

Here is the revised code, it just replaces the sbSearchRowsForBold code given above.

Code:

Sub sbSearchRowsForBold()

' Consolidate into a single string so we can search using instring  to checkif the found text is a Key Term
' If Selection.Find.Text = "Organization" Or Selection.Find.Text = "Date" Or Selection.Find.Text = "Description" Or Selection.Find.Text = "Aerospace, Space & Defence" Or Selection.Find.Text = "Automotive" Or Selection.Find.Text = "Manufacturing" Or Selection.Find.Text = "Life Sciences" Or Selection.Find.Text = "Information Communication Technologies / Digital" Or "Natural Resources / Energy" Or Selection.Find.Text = "Regional Stakeholders" Or Selection.Find.Text = "Other Policy Priorities" Then
' Some of the text entries include ',' so + is used as a seperator
Const myKeyTerms            As String = _
    "OrganizationDate+Description+Aerospace, Space & Defence+Automotive+Manufacturing+Life Sciences+Information Communication Technologies / Digital+Natural Resources / Energy+Regional Stakeholders+Other Policy Priorities"

Dim myTable                 As Table
Dim myFirstRange            As Range
Dim mySecondRange           As Range
Dim myRemoveRange           As Range
Dim SecondRangeFlag         As Boolean
    For Each myTable In ActiveDocument.Tables
        Set myFirstRange = Nothing
        SecondRangeFlag = False
        Do
            If myFirstRange Is Nothing Then
                Set myFirstRange = fnFindBold(mySearchRange:=myTable.Range.Rows(1).Range)
            Else
                Set myFirstRange = fnFindBold(mySearchRange:=myFirstRange.Next(unit:=wdRow))
            End If
            ' two possible cases for myFirstrange
            ' 1. a found range
            ' 2. nothing - which means we have searched the whole table.
            If Not myFirstRange Is Nothing Then
                If InStr(myKeyTerms, myFirstRange.Text) = 0 Then
                    ' Found bold text that is not a defined category (key term)
                    Set mySecondRange = myFirstRange.Duplicate
                    Do
                        Set mySecondRange = fnFindBold(mySecondRange.Next(unit:=wdRow))
                        If mySecondRange Is Nothing Then
                            SecondRangeFlag = True
                        Else
                            If InStr(myKeyTerms, mySecondRange.Text) > 0 Then
                                SecondRangeFlag = True
                            End If
                        End If
                    Loop Until SecondRangeFlag
                    'We have now found text that is a defined category key term
                    Set myRemoveRange = myFirstRange.Duplicate
                    If mySecondRange Is Nothing Then
                        myRemoveRange.End = myTable.Range.End
                        Set myFirstRange = Nothing
                    Else
                        myRemoveRange.End = mySecondRange.Previous(unit:=wdRow).End
                        Set myFirstRange = mySecondRange
                    End If
                    myRemoveRange.Select
                    myRemoveRange.Cut
                    ' the destiny of the cut text is left to the requirements of the user
                End If
            End If
        Loop Until myFirstRange Is Nothing
            
    Next myTable
    
End Sub

OfficeAssociate99 · #11 06-20-2017, 08:50 AM

This *almost* works, but for two issues I am trying to solve. 1) for whatever reason, the code is not recognizing "Life Sciences" as a defined category. 2) For whatever range is selected for an undefined category, it should include the category heading, and not just the data. So close...

slaycock · #12 06-20-2017, 09:04 AM

If I run the updated code on

OrganizationDate
2 Data row
3 Data row
4 Data row
Undefined category
6 Data row
7 Data row
8 Data row
Life Sciences
10 Data row
11 Data row
12 Data row
Undefined category
6 Data row
7 Data row
8 Data row

I am left with

OrganizationDate
2 Data row
3 Data row
4 Data row
Life Sciences
10 Data row
11 Data row
12 Data row

So for point 1 check the spelling of the Life Sciences category in your document matches that in the KeyTerms string (and that includes the number of spaces between the two words)

For 2 I can't reproduce what I think you are saying in that you are getting

OrganizationDate
2 Data row
3 Data row
4 Data row
Undefined category
Life Sciences
10 Data row
11 Data row
12 Data row
Undefined category

Which I don't.

OfficeAssociate99 · #13 06-20-2017, 09:52 AM

Ok, it works perfectly now. Thanks for all your help!

OfficeAssociate99 · #14 06-20-2017, 10:28 AM

Actually, one more slight problem. If I copy and paste a row, and then change the name and make it bold, the program doesn't recognize it as bolded. Any thoughts?

EDIT 1: I have figured out the issue lies with the "insert as new rows" paste function.

EDIT 2: It now works entirely as intended. I cannot thank you enough.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color	jc491	Word VBA	8	09-30-2015 06:10 AM
Text in #1 is made bold, rest of the document is edited, text in #1 is now not bold	footer-assistance	Word	1	06-29-2015 03:49 AM
VBA Search Table for Text/Select Text/Insert Hyperlink	sldrellich	Word VBA	3	03-24-2015 01:09 PM
how to search and replace BOLD text >> font color change?	dylansmith	Word	4	03-12-2013 09:51 PM
exporting bold text from excel to word?	stella@happisburgh.net	Excel	3	12-05-2010 08:03 AM