Avatar of Shyamulee Das
Shyamulee Das
Flag for India asked on

How to use bookmark in Word Vba?

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
   .Filters.Add "Excel files", "*.xlsx"
   
    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

Open in new window

VBAMicrosoft Word

Avatar of undefined
Last Comment
Shyamulee Das

8/22/2022 - Mon
GrahamSkan

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

Open in new window


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
    doc.Bookmarks.Add strBookMarkName, rng
End Sub

Open in new window


Not quite sure how you need it in your code
GrahamSkan

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

Open in new window

Shyamulee Das

ASKER
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
            Selection.Range.Bookmarks.Add bmName
        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

Open in new window


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
Your help has saved me hundreds of hours of internet surfing.
fblack61
GrahamSkan

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?
Shyamulee Das

ASKER
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.
It is not necessary to use bookmark, if you have any other way then please help.
Method-Detail_BeforeBookmark.docx
METHOD-DETAILS_AfterBookmark_output.docx
Shyamulee Das

ASKER
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.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
GrahamSkan

I still don't understand what the bookmarks are for. There are none in the documents
Shyamulee Das

ASKER
I need to create the bookmarks. I have no idea to use bookmarks.
GrahamSkan

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.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Shyamulee Das

ASKER
No problem.
So how should I code my problem?
aikimark

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?
Shyamulee Das

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

Is it possible using bookmarks for such kind of problem ?
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
GrahamSkan

I don't see how bookmarks can help you.

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.
Shyamulee Das

ASKER
Other than bookmarks what can help me?
GrahamSkan

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.
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Shyamulee Das

ASKER
Ohh.. sorry to make it complicated.
aikimark

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.
Shyamulee Das

ASKER
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.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
GrahamSkan

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 "

Open in new window

Shyamulee Das

ASKER
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.
Shyamulee Das

ASKER
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".

I am uploading both the files.
Doc2.docx
Units-Words.xlsx
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
GrahamSkan

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

Open in new window

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

Open in new window

Shyamulee Das

ASKER
No Replacement happening after running the macro.. :(
GrahamSkan

Strange. I will check
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
GrahamSkan

I guess I did a last minute tidy up of the code and didn't test it properly.
Shyamulee Das

ASKER
okay..
ASKER CERTIFIED SOLUTION
GrahamSkan

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Shyamulee Das

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

Otherwise working great!! Thank you.
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
GrahamSkan

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.
Shyamulee Das

ASKER
Quick Response..
You are really nice in answering questions.

Thank you.
Shyamulee Das

ASKER
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.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.