View Single Post
 
Old 05-28-2024, 11:06 AM
gmaxey gmaxey is offline Windows 10 Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,617
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

May not be perfect for your requirement, but should get you close:


Code:
Option Explicit
Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oTbl As Table
Dim lngIndex As Long
Dim colBMs As New Collection
Dim oBM As Bookmark
Dim strBMName As String
Dim oRNg As Range
Dim bValid As Boolean
  'Get the collection of existing bookmarks
  For Each oBM In ActiveDocument.Bookmarks
    colBMs.Add oBM.Name, oBM.Name
  Next oBM
  Set oTbl = Selection.Tables(1)
  bValid = True
  For lngIndex = 1 To oTbl.Rows.Count
    Set oRNg = oTbl.Cell(lngIndex, 1).Range
    oRNg.End = oRNg.End - 1
    strBMName = fcnValidateBMName(oRNg.Text)
    On Error Resume Next
    colBMs.Add strBMName, strBMName
    If Err.Number = 0 Then
      ActiveDocument.Bookmarks.Add strBMName, oRNg
    Else
       oTbl.Cell(lngIndex, 1).Range.Shading.BackgroundPatternColor = wdColorRed
       bValid = False
    End If
    On Error GoTo 0
  Next lngIndex
  If bValid Then
    MsgBox "Processing complete."
  Else
    MsgBox "Processing complete. One or more rows could not be bookmarked due to a duplicate name."
  End If
lbl_Exit:
  Exit Sub
End Sub

Function fcnValidateBMName(strIn As String) As String
  strIn = Trim(strIn)
  strIn = Replace(strIn, " ", "_")
  If IsNumeric(Left(strIn, 1)) Then
    strIn = "_" & strIn
  End If
  fcnValidateBMName = strIn
End Function
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote