How to change the font color of specific text within a Word table cell

[rmatthews]

I have hundreds of Word tables that have data cells formatted like:
13.45 [56.34]

I know how to highlight or change the font color for the entire cell, but what I want to be able to do is programmatically change ONLY the color of the numbers within the brackets. So the cell would look like:
13.45 [56.34]

Thanks in advance.

Robert

[gmaxey]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "\[*\]"
    .MatchWildcards = True
    While .Execute
      If oRng.Information(wdWithInTable) Then
        With oRng
          .End = .End - 1
          .Start = .Start + 1
          .Font.ColorIndex = wdBlue
          .Collapse wdCollapseEnd
        End With
      End If
    Wend
  End With
lbl_Exit:
  Exit Sub
  
End Sub

[macropod]

Cross-posted at: http://www.msofficeforums.com/word-t...xt-within.html


Please read VBA Express' policy onCross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3

[rmatthews]

Greg, the code you provided works, but unfortunately it takes hours to run because the document is huge. Here's a snippet of code from the application. I think it would be much more efficient if I could just color the text as it's being inserted into the document at run time. The variable CELLVALUE is what gets wrapped in brackets and is what I want to color blue.

For Each TblCell In Tbl.Range.Cells
 With TblCell
  Set RNG = .Range
  With RNG
   If InStr(UCase$(.Text), CellID) > 0 Then
    If CellHasText = "N" Then
     .End = .Start + InStr(UCase$(.Text), CellID) - 1
     If CellValue <> "" Then
      .Text = .Text & vbCr & " [" & CellValue & "]"
      .Font.Hidden = False
      CellCounter = CellCounter + 1
     Else
         '  ... more code
      End if
    End if
    End if
 End With
 End With
Next

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "\[*\]"
    .MatchWildcards = True
    While .Execute
      If oRng.Information(wdWithInTable) Then
        With oRng
          .End = .End - 1
          .Start = .Start + 1
          .Font.ColorIndex = wdBlue
          .Collapse wdCollapseEnd
        End With
      End If
    Wend
  End With
lbl_Exit:
  Exit Sub
  
End Sub

[gmaxey]

Seems that you could just add:

.Font.ColorIndex = wdBlue

to your existing macro after the .Font.Hidden = False line.

[macropod]

As indicated in my reply to your cross-post (q.v.), if there isn't any content that might be affected outside tables, you could simply use:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Replacement.Text = "^&"
    .Text = "\[[0-9.]{1,}\]"
    .Replacement.Font.ColorIndex = wdBlue
    .Execute Replace:=wdReplaceAll
    .Text = "[\[\]]"
    .Replacement.Font.ColorIndex = wdAuto
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

If there is such content outside tables that you don't want to affect, you could use (the slower):

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table
For Each Tbl In ActiveDocument.Range.Tables
  With Tbl
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = True
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Replacement.Text = "^&"
      .Text = "\[[0-9.]{1,}\]"
      .Replacement.Font.ColorIndex = wdBlue
      .Execute Replace:=wdReplaceAll
      .Text = "[\[\]]"
      .Replacement.Font.ColorIndex = wdAuto
      .Execute Replace:=wdReplaceAll
    End With
  End With
Next
Application.ScreenUpdating = True
End Sub