# How to use bookmark in Word Vba?

Shyamulee Das used Ask the Experts™
on
I want to use bookmark in MS word using vba.
There is an excel sheet to find words and replace in document. In the list there are expansion of number units (eg: Hz - hertz) but I want to ignore this to replace in my word doc if its after a number(eg: 90 Hz). If it is anywhere in text then it can replace with its expansion.
So I want to use bookmark whenever it finds "number" before the "unit" and the name of the bookmark can be "autounit_1" for the 1st time it finds then for 2nd "autounit_2" and so on.
Whenever the macro will  run it will ignore the bookmark and replace the rest.

My code: it is only replacing whatever is listed in excel. I want to use bookmark in this.

Sub Replace()

Dim xl As New Excel.Application
Dim wb As Workbook
xl.Visible = False
Dim ws As Worksheet
Dim SelectedFileItem As String
Dim FDialog As FileDialog
Set FDialog = Application.FileDialog(msoFileDialogOpen)
Dim lastRow
Dim find_text
Dim replace_text
Dim oCell
Dim r As Range
Dim afile
Dim ExcelWasNotRunning As Boolean
Dim num_chk
Dim bmRange As Range

Set bmRange = ActiveDocument.Bookmarks("autounit").Range

With FDialog
.Title = "Select a file"
.AllowMultiSelect = False
.InitialFileName = "D:\OneDrive - CACTUS\Documents"
.Filters.Clear

If .Show = -1 Then
SelectedFileItem = .SelectedItems(1)
afile = SelectedFileItem
Else
MsgBox "You cancelled the operation"
Exit Sub
End If
End With

On Error Resume Next

If Err Then
ExcelWasNotRunning = True
Set xl = CreateObject("Excel.Application")
End If

On Error GoTo 0
With xl
Set wb = xl.Workbooks.Open(afile)
Set ws = wb.Sheets("sheet1")
ws.Activate

End With

If ExcelWasNotRunning Then
xl.Quit
End If

lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
num_chk = "([{.,%,/,-}]" + "[0-9] )"

For oCell = 2 To lastRow
find_text = ws.Range("A" & oCell).Value
replace_text = ws.Range("B" & oCell).Value
find_text = "(" + find_text + ")"

Set r = ActiveDocument.Content

r.Find.ClearFormatting

With r.Find
Options.DefaultHighlightColorIndex = wdGray25
.ClearFormatting
.Replacement.ClearFormatting
.MatchCase = True
.Text = find_text
.MatchWholeWord = True
.Replacement.Text = replace_text
.Replacement.Highlight = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

Next oCell

MsgBox " Replacement Completed "
End Sub

Comment
Watch Question

Do more with

EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Retired
Top Expert 2012

Commented:
You can do it simply, so
doc.Bookmarks("mybookmark").Range.Text = "new text"


You can improve the operation by checking that the bookmark is there, and by replacing it after the text has been added.  I use a sub-routine like this:
Sub ReplaceBookmarkText(doc As Word.Document, strBookMarkName As String, strText As String)
Dim bmk As Word.Bookmark
Dim rng As Range

If doc.Bookmarks.Exists(strBookMarkName) Then
Set bmk = doc.Bookmarks(strBookMarkName)
Else
MsgBox "Bookmark: " & strBookMarkName & " not found in document " & doc.Name
Exit Sub
End If
Set rng = bmk.Range
rng.Text = strText

'The bookmark will have been overwritten, so  replace it for future use
End Sub


Not quite sure how you need it in your code
Retired
Top Expert 2012

Commented:
I think you should add  the procedure ReplaceBookmarkText and replace lines 60 to 83 with this:

    For ocell = 2 To lastRow
strBookMarkName = "autounit_" & Format(ocell - 1, "00")
replace_text = ws.Range("B" & ocell).Value
Replacebookmarktext ActiveDocument, strBookMarkName, replace_text
Next ocell

Automation Analyst

Commented:
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
num_chk = "([{.,%,/,-}]" + "[0-9] )"

For oCell = 2 To lastRow
find_text = ws.Range("A" & oCell).Value
replace_text = ws.Range("B" & oCell).Value
find_text = "(" + find_text + ")"
Z = 0
Set r = ActiveDocument.Content

With r.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = num_chk + find_text
.Replacement.Text = ""
.Wrap = wdFindStop
.Execute = True
Z = Z + 1
bmName = "autounit" + "_" + Z
End With

r.Find.ClearFormatting
With r.Find
Options.DefaultHighlightColorIndex = wdGray25
.ClearFormatting
.Replacement.ClearFormatting
.MatchCase = True
.Text = find_text
.MatchWholeWord = True
.Replacement.Text = replace_text
.Replacement.Highlight = True
.Wrap = wdFindStop

Do While .Execute
If Selection.Bookmarks.count > 0 Then
Selection.MoveLeft unit:=wdCharacter, count:=9, Extend:=wdExtend

Loop
End With

Next oCell
End Sub


I am not familiar with bookmark so please correct me in my code.
>>My 1st find section is looking for numbers and units in doc and bookmarking the same.
>>My second find section will replace words which are in list and ignore replacing the expansion of "Units" after a number. If and only if the Units are in text then only it can replace.

Wherever there is units next to number (eg: 5 mM ) they shouldn't get replaced, But if the same units are in text they will get replaced.

Thank you.

I am attaching my excel sheet and the doc.
Units-Words.xlsx
METHOD-DETAILS.docx
Retired
Top Expert 2012

Commented:
It isn't clear what you are trying to achieve.

As it stands, the first Find loop will add a bookmark for the first instance of the text from the WordsToFind column of the spreadsheet. What should happen if the text from the WordsToFind column appears more than once in the document? Bookmark names must be unique.

What do you want to happen in the second Find loop?
Automation Analyst

Commented:
I want to replace expansion of units in text not after number. I have uploaded two doc files, one is the file which is before bookmark created and the other one is after bookmark created.

What do you want to happen in the second Find loop?
Bookmark name should be different /increment for every "number" found before the "units". eg: [autounit_1], [autounit_2], etc.

As it stands the first Find loop will add a bookmark for the first instance of the text from the WordsToFind column of the spreadsheet
I want to replace for all instances not only 1st instance.
Method-Detail_BeforeBookmark.docx
METHOD-DETAILS_AfterBookmark_output.docx
Automation Analyst

Commented:
It should bookmark if it finds number before any units in the document and then replace only the required words listed in the excel. If there are units(mm, mL) between the text instead before a number, replace it with their expansion.
This is my requirement. In my above comment I have attached two docs just for reference, 1st one is what is happening and 2nd one is what I want.
Retired
Top Expert 2012

Commented:
I still don't understand what the bookmarks are for. There are none in the documents
Automation Analyst

Commented:
I need to create the bookmarks. I have no idea to use bookmarks.
Retired
Top Expert 2012

Commented:
Sorry for the delay. I went to lunch.

Bookmarks are used to mark ranges (words, sentences etc) so that they can easily be found again.

In the user interface, you can set them via the Insert tab and use Find/Go on the Home tab to locate them. There is an option (Advanced/Show document content) to make them visible in the text. They then appear as grey square brackets, '[' to start and ']' to end. A bookmark that has no length, so simply marks a position looks like an upper case 'i' does in most fonts.

I have already illustrated the way that they can be used in VBA code.
Automation Analyst

Commented:
No problem.
So how should I code my problem?
Top Expert 2014

Commented:
I need to create the bookmarks. I have no idea to use bookmarks.
If you have no idea how to use bookmarks, why are you trying to create them, manually or programmatically?
Automation Analyst

Commented:
Programmatically.. I have read about it but cannot understand to put in code..

Is it possible using bookmarks for such kind of problem ?
Retired
Top Expert 2012

Commented:

The purpose if a bookmark is to label part of a document (a range) so that it can be easily found later. Bookmarks are saved with the document. If they are not required after the macro has run, they will rarely be used.
Automation Analyst

Commented:
Other than bookmarks what can help me?
Retired
Top Expert 2012

Commented:
We can probably get the macro to do what you need without involving bookmarks. It was only the requirement to use bookmarks that got us scratching our heads.
Automation Analyst

Commented:
Ohh.. sorry to make it complicated.
Top Expert 2014

Commented:
This comes back to problem definition.  You have asked your question in "how do I implement this solution this way" terms and not in terms of "I have x problem that needs a solution".  In other words, you have asked a HOW question, rather than a WHAT question.

It seems to us (EE experts) that you have already decided that bookmarks are the desired solution to your problem(s).  But it is clear that you do not understand bookmarks.  I think you should drop back and describe your problem as an actual problem, letting the experts decide what elements/processes/algorithms are best suited to your eventual solution.  We might present you with choices or not.  Your problem description is the starting point for our conversation and may impose constraints/restrictions on our solution choices.
Automation Analyst

Commented:
There is an excel sheet with list of words and its expansion, there are some list of units expansion in it. Now in my document I want to replace the words with its given expansion but as there are some units expansion it even replaces units next to a number (eg: 5 millimeter) which is the problem. It shouldn't replace units expansion next to a number. But if the units are in text or between the text then it should replace with its expansion (eg: However, kilohertz frequencies have been used.)

The files are available in the above comments.

Thank you.
Retired
Top Expert 2012

Commented:
I think this will work, though it converts  'Antimycin A' to 'Antimycin amperes', which  I guess you don't want

    For oCell = 2 To lastRow
find_text = ws.Range("A" & oCell).Value
replace_text = ws.Range("B" & oCell).Value
Set wrdRange = ActiveDocument.Content
With wrdRange.Find
.MatchCase = True
.Text = find_text
.MatchWholeWord = True
Do While .Execute()
Set wrdRange2 = wrdRange.Duplicate
wrdRange2.Collapse wdCollapseStart
wrdRange2.MoveStart wdWord, -1
If Not IsNumeric(wrdRange2.Text) Then
wrdRange.Text = replace_text
wrdRange.HighlightColorIndex = wdYellow
End If
Loop
End With
Next oCell

MsgBox " Replacement Completed "

Automation Analyst

Commented:
it converts  'Antimycin A' to 'Antimycin amperes', which  I guess you don't want
Yes..
And even it converts "37°C to 37°copies OR coulomb" which I don't want ..
Can you please solve this problem ?
It works in case of numbers :)

Thank you.
Automation Analyst

Commented:
I have added two more units for testing so I got unwanted conversion.
Line 58 of the doc-
2-Fluor-2- desoxy-D-glucose
In this line "D" gets converted to "diopter".

Doc2.docx
Units-Words.xlsx
Retired
Top Expert 2012

Commented:
This version ignores abbreviations joined to prior or following words with the hyphen character, ampersand or degree sign.

This protects such abbreviations, including  'desoxy-D-glucose' and 'R&D' from substitution.

Modified loop
    For oCell = 2 To lastRow
find_text = ws.Range("A" & oCell).Value
replace_text = ws.Range("B" & oCell).Value
Set wrdRange = ActiveDocument.Content
wrdRange.Find.ClearFormatting
With wrdRange.Find
.MatchCase = True
.Text = find_text
.MatchWholeWord = True
Do While .Execute()
'get previous word
Set wrdRange2 = wrdRange.Duplicate
wrdRange2.Collapse wdCollapseStart
wrdRange2.MoveStart wdWord, -1
'test previous word
If IsNumeric(wrdRange2.Text) Then
'do nothing
ElseIf IsJoined(wrdRange) Then
'do nothing
Else
wrdRange.Text = replace_text
wrdRange.HighlightColorIndex = wdYellow
End If
Loop
End With
Next oCell

Extra function
Function IsJoined(wrdRng As Word.Range) As Boolean
Dim rng As Word.Range
Dim Joiners As String

Joiners = "-&°"

'check previous character
Set rng = wrdRng.Duplicate
rng.Collapse wdCollapseStart
rng.MoveStart wdCharacter, -1
IsJoined = InStr(Joiners, rng.Text)
If IsJoined Then
Exit Function
End If

'check following character
Set rng = wrdRng.Duplicate
rng.Collapse wdCollapseEnd
rng.MoveStart wdCharacter, 1
IsJoined = InStr(Joiners, rng.Text)
End Function

Automation Analyst

Commented:
No Replacement happening after running the macro.. :(
Retired
Top Expert 2012

Commented:
Strange. I will check
Retired
Top Expert 2012

Commented:
I guess I did a last minute tidy up of the code and didn't test it properly.
Automation Analyst

Commented:
okay..
Retired
Top Expert 2012
Commented:
While concentrating on not replacing some targets, I overlooked those that should be changed. Both code blocks have been modified.

Sub ReplaceAbbreviations()

Dim xl As New Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim SelectedFileItem As String
Dim FDialog As FileDialog
Dim lastRow
Dim find_text
Dim replace_text
Dim oCell
Dim wrdRange As Word.Range
Dim wrdRange2 As Word.Range
Dim afile As String
Dim ExcelWasNotRunning As Boolean
Dim num_chk
Dim bTest As Boolean

bTest = False 'for my testing - Graham
xl.Visible = False

'Set bmRange = ActiveDocument.Bookmarks("autounit").Range
If bTest Then
afile = "I:\Allwork\ee\29118949\Units-Words.xlsx"
Else
Set FDialog = Application.FileDialog(msoFileDialogOpen)
With FDialog
.Title = "Select a file"
.AllowMultiSelect = False
.InitialFileName = "D:\OneDrive - CACTUS\Documents"
.Filters.Clear

If .Show = -1 Then
SelectedFileItem = .SelectedItems(1)
afile = SelectedFileItem
Else
MsgBox "You cancelled the operation"
Exit Sub
End If
End With
End If

Set xl = CreateObject("Excel.Application")

With xl
Set wb = xl.Workbooks.Open(afile)
Set ws = wb.Sheets("sheet1")
End With

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
num_chk = "([{.,%,/,-}]" + "[0-9] )"

For oCell = 2 To lastRow
find_text = ws.Range("A" & oCell).Value
replace_text = ws.Range("B" & oCell).Value
Set wrdRange = ActiveDocument.Content
wrdRange.Find.ClearFormatting
With wrdRange.Find
.MatchCase = True
.Text = find_text
.MatchWholeWord = True
Do While .Execute()
'get previous word
Set wrdRange2 = wrdRange.Duplicate
'wrdRange2.Select 'debugging
'Stop 'debugging
wrdRange2.Collapse wdCollapseStart
wrdRange2.MoveStart wdWord, -1
'test previous word
If IsNumeric(wrdRange2.Text) Then
'do nothing
ElseIf IsJoined(wrdRange) Then
'do nothing
Else
wrdRange.Text = replace_text
wrdRange.HighlightColorIndex = wdYellow
End If
wrdRange.Collapse wdCollapseEnd
wrdRange.End = ActiveDocument.Content.End
Loop
End With
Next oCell

MsgBox "Replacement Completed"
End Sub

Function IsJoined(wrdRng As Word.Range) As Boolean
Dim rng As Word.Range
Dim Joiners As String

Joiners = "-&°"

'check previous character
Set rng = wrdRng.Duplicate
rng.Collapse wdCollapseStart
rng.MoveStart wdCharacter, -1
IsJoined = InStr(Joiners, rng.Text)
If IsJoined Then
Exit Function
End If

'check following character
Set rng = wrdRng.Duplicate
rng.Collapse wdCollapseEnd
rng.MoveEnd wdCharacter, 1
IsJoined = InStr(Joiners, rng.Text)
End Function

Automation Analyst

Commented:
In line 123 "Antimycin A ", "A" is replaced by "amperes".

Otherwise working great!! Thank you.
Retired
Top Expert 2012

Commented:
Yes. I told you about that. We could catch that by checking for the word 'Antimycin', but 'A' is especially vulnerable, since it is also a common word.
Automation Analyst

Commented:
Quick Response..
You are really nice in answering questions.

Thank you.
Automation Analyst

Commented:
Yes. I told you about that. We could catch that by checking for the word 'Antimycin', but 'A' is especially vulnerable, since it is also a common word.
Okay.

Do more with