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

Shyamulee DasAutomation AnalystAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

GrahamSkanRetiredCommented:
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
0
GrahamSkanRetiredCommented:
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

0
Shyamulee DasAutomation AnalystAuthor 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
            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
0
OWASP: Threats Fundamentals

Learn the top ten threats that are present in modern web-application development and how to protect your business from them.

GrahamSkanRetiredCommented:
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?
0
Shyamulee DasAutomation AnalystAuthor 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.
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
0
Shyamulee DasAutomation AnalystAuthor 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.
0
GrahamSkanRetiredCommented:
I still don't understand what the bookmarks are for. There are none in the documents
0
Shyamulee DasAutomation AnalystAuthor Commented:
I need to create the bookmarks. I have no idea to use bookmarks.
0
GrahamSkanRetiredCommented:
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.
0
Shyamulee DasAutomation AnalystAuthor Commented:
No problem.
So how should I code my problem?
0
aikimarkCommented:
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?
0
Shyamulee DasAutomation AnalystAuthor Commented:
Programmatically.. I have read about it but cannot understand to put in code..

Is it possible using bookmarks for such kind of problem ?
0
GrahamSkanRetiredCommented:
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.
0
Shyamulee DasAutomation AnalystAuthor Commented:
Other than bookmarks what can help me?
0
GrahamSkanRetiredCommented:
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.
0
Shyamulee DasAutomation AnalystAuthor Commented:
Ohh.. sorry to make it complicated.
0
aikimarkCommented:
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.
0
Shyamulee DasAutomation AnalystAuthor 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.
0
GrahamSkanRetiredCommented:
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

0
Shyamulee DasAutomation AnalystAuthor 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.
0
Shyamulee DasAutomation AnalystAuthor 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".

I am uploading both the files.
Doc2.docx
Units-Words.xlsx
0
GrahamSkanRetiredCommented:
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

0
Shyamulee DasAutomation AnalystAuthor Commented:
No Replacement happening after running the macro.. :(
0
GrahamSkanRetiredCommented:
Strange. I will check
0
GrahamSkanRetiredCommented:
I guess I did a last minute tidy up of the code and didn't test it properly.
0
Shyamulee DasAutomation AnalystAuthor Commented:
okay..
0
GrahamSkanRetiredCommented:
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
        .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
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

Open in new window

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

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Shyamulee DasAutomation AnalystAuthor Commented:
In line 123 "Antimycin A ", "A" is replaced by "amperes".

Otherwise working great!! Thank you.
0
GrahamSkanRetiredCommented:
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.
0
Shyamulee DasAutomation AnalystAuthor Commented:
Quick Response..
You are really nice in answering questions.

Thank you.
0
Shyamulee DasAutomation AnalystAuthor 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.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.