sequentially bookmark cells in all tables using VBA

Dear Experts:

I wonder whether the following can be achieved by running a macro:

- loop thru all the tables of the active document

- For each table do the following:
      Go to the second row and bookmark the first and fourth cell sequentially as follows:
           bookmark_1 (first cell of the 2nd row) and bookmark_2 (fourth cell of the 2nd row)

The second table's bookmarks would be as follows:
           bookmark_3 (first cell of the 2nd row) and bookmark_4 (fourth cell of the 2nd row)

The third table's bookmarks would be as follows:
           bookmark_5 (first cell of the 2nd row) and bookmark_6 (fourth cell of the 2nd row)

and so forth.

I hope I could make myself clear.

Thank you very much in advance.

Regards, Andreas
Andreas HermleTeam leaderAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
GrahamSkanConnect With a Mentor RetiredCommented:
This avoids the cell delimiter characters which the cell.range property returns
Sub AddTableBookmarks()
    Dim tbl As Table
    Dim b As Integer
    Dim rng As Range
    
    b = 1
    With ActiveDocument
        For Each tbl In .Tables
            Set rng = tbl.Cell(2, 1).Range
            rng.MoveEnd wdCharacter, -1
            .Bookmarks.Add ("bookmark_" & b), rng
            
            Set rng = tbl.Cell(2, 4).Range
            rng.MoveEnd wdCharacter, -1
            .Bookmarks.Add ("bookmark_" & b + 1), rng
            b = b + 2
        Next tbl
    End With
    
End Sub

Open in new window

0
 
Chris BottomleyCommented:
Not to say there aren't more efficient ways but for example on the activedocument try:

Sub markit()
Dim tbl As Table
Dim bkm As Bookmark
Dim bolFound As Boolean
Dim intNumber As Integer

    intNumber = 1
    For Each tbl In ActiveDocument.Tables
        bolFound = False
        For Each bkm In tbl.Cell(2, 1).Range.Bookmarks
            If LCase(bkm.Name) = "bookmark_" & intNumber Then
                bolFound = True
                Exit For
            End If
        Next
        If Not bolFound Then ActiveDocument.Bookmarks.Add Name:="bookmark_" & intNumber, Range:=tbl.Cell(2, 1).Range
        
        bolFound = False
        For Each bkm In tbl.Cell(2, 4).Range.Bookmarks
            If LCase(bkm.Name) = "bookmark_" & intNumber + 1 Then
                bolFound = True
                Exit For
            End If
        Next
        If Not bolFound Then ActiveDocument.Bookmarks.Add Name:="bookmark_" & intNumber + 1, Range:=tbl.Cell(2, 4).Range
        intNumber = intNumber + 2
    Next
    
End Sub

Open in new window


Chris
0
 
GrahamSkanRetiredCommented:
Hi Andreas. Try it like this.
Sub AddTableBookmarks()
    Dim tbl As Table
    Dim b As Integer
   
    b = 1
    With ActiveDocument
        For Each tbl In .Tables
            .Bookmarks.Add ("bookmark_" & b), tbl.Cell(2, 1).Range
            .Bookmarks.Add ("bookmark_" & b + 1), tbl.Cell(2, 4).Range
            b = b + 2
        Next tbl
    End With
   
End Sub
0
[Webinar] Kill tickets & tabs using PowerShell

Are you tired of cycling through the same browser tabs everyday to close the same repetitive tickets? In this webinar JumpCloud will show how you can leverage RESTful APIs to build your own PowerShell modules to kill tickets & tabs using the PowerShell command Invoke-RestMethod.

 
Andreas HermleTeam leaderAuthor Commented:
Dear both,

both codes work fine. Thank you very much for it. The trouble is ...

... I forgot to mention that only the text in the cells are to be bookmarked. Sorry about that.

With your code the whole cell including the cell marker get bookmarked and hence if I insert a crossreference in my document refering to the bookmark text, a table cell gets inserted.

Could you please tweak the code so that only the cell's text gets bookmarked.

Thank you very much in advance.

Regards, Andreas
0
 
Chris BottomleyConnect With a Mentor Commented:
Adapting to Grahams code since the error tests are superfluous ... Try:

Sub AddTableBookmarks()
' note case insensitive on naming
' note relocates an existing bookmark or creates it anew therefore no need to test
Dim tbl As Table
Dim intNumber As Integer
    
    intNumber = 1
    With ActiveDocument
        For Each tbl In .Tables
            .Bookmarks.Add ("bookmark_" & intNumber), ActiveDocument.Range(tbl.Cell(2, 1).Range.Start, tbl.Cell(2, 1).Range.End - 1)
            .Bookmarks.Add ("bookmark_" & intNumber + 1), ActiveDocument.Range(tbl.Cell(2, 4).Range.Start, tbl.Cell(2, 4).Range.End - 1)
            intNumber = intNumber + 2
        Next tbl
    End With
    
End Sub

Chris

Open in new window

0
 
Andreas HermleTeam leaderAuthor Commented:
Dear Graham + Chris,

thank you very much for your great support. Both codes work just fine.

Regards, Andreas
0
All Courses

From novice to tech pro — start learning today.