Solved: Change Word 2003 table cell color based on cell text?

[arlmonter97]

Hello,

I have a table in Word 2003. The file consists entirely of the one table with 6-7 columns and dozens of rows. The background color is white. One column (of a defined, constant position) will contain single word entries such as "orange", "green" or "blue". I would like a macro to read the word or text in the cell and convert the background color of that particular cell to whatever is pre-defined in the macro (i.e., if the macro sees a cell with "green" it will color the cell green based on what I chose in the macro).

Is this possible? I'm searching the web and have some leads and am just now trying to record macros and figure out how to do code some of this. I have minimal VBA background but have done some in excel in years past.

Regards

[lucas]

Untested:
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="green", MatchWholeWord:=True, Forward:=True) = True
r.Cells(1).Shading.BackgroundPatternColorIndex = wdGreen
Loop
End With

[arlmonter97]

Thank you - this is very helpful!

[Kilroy]

Hello I know this closed but I'm wondering if this code can be changed for two scenarios

1. If the first cell in the row contains "green" the entire row is colored instead of just the cell. If "green" is in cells other than column one it is ignored.

2. I have a 4 column table. In the second column if a cell has an ":" I need just the next 2 cells in that row colored. Not the cell containing ":" just cell 3 & 4 of that row.


I know after working with VBA for a while now I should probably be able to do this but I've spent 4 hours spinning my wheels. Any help is appreciated.

[gmaxey]

Something like this:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim r As Range
Dim oRng As Word.Range
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="green", MatchWholeWord:=True, Forward:=True)
If r.Information(wdWithInTable) Then
If r.InRange(r.Rows(1).Cells(1).Range) Then
r.Rows(1).Shading.BackgroundPatternColorIndex = wdGreen
End If
End If
Loop
End With
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:=":", MatchWholeWord:=True, Forward:=True)
If r.Information(wdWithInTable) Then
If r.InRange(r.Rows(1).Cells(2).Range) Then
Set oRng = r.Rows(1).Range
oRng.Start = r.Rows(1).Cells(3).Range.Start
oRng.Shading.BackgroundPatternColorIndex = wdGreen
End If
End If
Loop
End With
lbl_Exit:
Exit Sub

End Sub

[Kilroy]

Thanks Greg it works perfect like usual. I've tried adding a statement to bold the text as well but not having any luck making it work. Any hints?

[Kilroy]

I've tried a lot so far.



Sub BoldIfCellIsColored()
Dim oRow As Row
With Selection.Tables(1)
If oRow.Shading.BackgroundPatternColor = -603923969 Then
oRow.Font.Bold = True
End If
End With
End Sub

[Kilroy]

It's ugly but I got it working.


Sub BoldColoredCells()
With ActiveDocument
ChangeFont ActiveDocument
End With
End Sub
Function ChangeFont(wdDoc)
Dim oCell As Cell, oTbl As Table, oRow As Row
Dim i As Long
For Each oTbl In wdDoc.Tables
For Each oRow In oTbl.Rows
For Each oCell In oRow.Cells
If oCell.Shading.BackgroundPatternColor = -603923969 Then
oCell.range.Font.Bold = True
End If
Next
Next
Next

End Function

[gmaxey]

This might be no better but a bit faster:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "*"
.Format = True
.MatchWildcards = True
While .Execute
If oRng.Information(wdWithInTable) Then
If oRng.Cells(1).Shading.BackgroundPatternColor = -603923969 Then
oRng.Cells(1).Range.Font.Bold = True
oRng.End = oRng.Cells(1).Range.End
End If
oRng.Collapse wdCollapseEnd
End If
Wend
End With
lbl_Exit:
Exit Sub
End Sub

[Kilroy]

Thanks Greg looks much better too.