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-tables/35515-how-change-font-color-specific-text-within.html


Please read VBA Express' policy onCross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#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