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