Bold Words in Lists only

[sand60]

Hello Good people,

I am working on formatting lists found within the document.:)

I have done research on google and found you can replace in documents using a table.

Word Macro to run mulitple wildcard find and replace routines - cybertext wordpress

The table will hold my list of words to bold but i dont know how to proceed.

I adapted this from Greg, who wrote code to help with the lists, in one of my previous posts.

The below is a bit of a train wreck, i still cannot get it to work, or understand what it is doing.





Sub ReplaceFromTableList()

' from Doug Robbins, Word MVP, Microsoft forums, Feb 2015, based on another macro written by Graham Mayor, Aug 2010
Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim oRng As Range

Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim sFname As String

'Change the path in the line below to reflect the name and path of the table document
sFname = "C:\ListTable.docx"

Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
For i = 1 To oTable.Rows.Count
Set oRng = oDoc.Range

'A bit from Greg

Dim oPar As Paragraph
Dim lngIndex As Long

For Each oPar In ActiveDocument.Paragraphs
If oPar.Range.ListFormat.ListType = wdListBullet Then


For i = 1 To oTable.Rows.Count
Set oRng = oDoc.Range
Set rFindText = oTable.Cell(i, 1).Range
rFindText.End = rFindText.End - 1


Selection.HomeKey wdStory
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True


.Text = rFindText.Text
. Text.bold = true


.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next i
oChanges.Close wdDoNotSaveChanges

Next oPar
lbl_Exit:
Exit Sub




what am I trying to do? Good question

Succinctly put

List of words to be bolded in Column1 of the table

Search the document Lists only ( it is a range I presume?)

Bold the words ONLY if it is found within the documents lists range

Ignore everything else.

Thank you for your advice

Thank you for looking at this code.

Many thanks again

Sand

[gmaxey]

Yes you made quite a dog's breakfast out of that:


Sub ReplaceFromTableList()
Dim oDocSource As Document, oDoc As Document
Dim oTbl As Table
Dim oRng As Range
Dim lngIndex As Long
Set oDoc = ActiveDocument
'Change the path in the line below to reflect the name and path of the table document
Set oDocSource = Documents.Open(FileName:="C:\ListTable.docx", Visible:=False)
Set oTbl = ActiveDocument.Tables(1) 'oDocSource.Tables(1)
For lngIndex = 1 To oTbl.Rows.Count
Set oRng = oDoc.Range
With oRng.Find
.Text = Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2)
While .Execute
If oRng.Paragraphs(1).Range.ListFormat.ListType = wdListBullet Then
oRng.Font.Bold = True
End If
oRng.Collapse wdCollapseEnd
Wend
End With
Next lngIndex
oDocSource.Close wdDoNotSaveChanges
lbl_Exit:
Exit Sub
Exit Sub
End Sub

[sand60]

Greg,

not sure the doggy would be too happy eating my cooking :devil2:

Beans on toast is about it for my culniarly skills.

Thank you very much - your code is very tight and it looks very Clean and logical. I can understand and follow the methodology.

No seriously I did try to adapt it but after a few hours, word crashed so I thought I'd better SOS pronto

Great coding intel Greg,

thank you very much for helping

Great weekend all :grinhalo:

Super
Super!!!

Sand


** Cheers to forum - nice place and great people like Greg here - I appreciate your time for teaching me