Solved: How to change table cell background colour according to cell value?

[FhM]

I need some VBA code that will read the first column of a table in Word and change the colour of the cell according to the value.

The values will be either -1, 0, 1

-1 = Red
0 = Amber
1 = Green

I have seen some examples that refer to Excel but I am not sure if these will work.

Thanks in advance

[macropod]

Hi FhM,

Try something based on:
Sub ColourCells()
Dim oTbl As Table
Dim oCel As Cell
Dim oRng As Range
For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Columns(1).Cells
Set oRng = oCel.Range
oRng.End = oRng.End - 1
Select Case oRng.Text
Case -1
oCel.Shading.BackgroundPatternColorIndex = wdRed
Case 0
oCel.Shading.BackgroundPatternColorIndex = wdDarkYellow
Case 1
oCel.Shading.BackgroundPatternColorIndex = wdGreen
End Select
Next
Next
End SubThe above code shades each cell in the 1st column of every table in the document according to the cell's value (-1, 0, 1).

[FhM]

Ok I think I have most of the parts I need to do this now. My working code is as follows currently:


Sub test()
Dim CurrTable As Table
Dim myRow As Row
Set CurrTable = ActiveDocument.Tables(1)

For Each myRow In CurrTable.Rows
cellText = myRow.Cells(1).Range.Text
cellText = Left(cellText, Len(cellText) - 2)


If cellText = "X" Then
myRow.Cells(1).Range.Text = "X was detected"

End If
Next
End Sub


Which works fine but when I try and slip this extra code in I found:


Set myCell = myRow.Cells(myRow.Cells.Count)
With myCell
With .Shading
.BackgroundPatternColorIndex = wdGreen
End With

This works but it targets the last column because of .Count I cant change it to


Set myCell = myRow.Cells(myRow.Cells.1)

So what is the correct way to get it to only affect the first column?

[FhM]

Thank you Macropod I will try that out now. I was on the phone and typing my last reply so I completely missed yours.

[FhM]

Thank you that is absolutely perfect :) and certainly a lot simpler than the code I was working with.

[FhM]

I need to change this slightly. For example I need to read a value in column 3 then change the background colour of the cell in column 1 on that row. I cant quite get the syntax right for refering back to column 1.
Any help greatly appreciated.

[macropod]

Hi FhM,

Try something based on:
Sub ColourCells()
Dim oTbl As Table
Dim oRow As Row
Dim oRng As Range
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Rows
Set oRng = oRow.Cells(3).Range
oRng.End = oRng.End - 1
With oRow.Cells(1).Shading
Select Case oRng.Text
Case -1
.BackgroundPatternColorIndex = wdRed
Case 0
.BackgroundPatternColorIndex = wdDarkYellow
Case 1
.BackgroundPatternColorIndex = wdGreen
End Select
End With
Next
Next
End Sub

[FhM]

Thats fantastic thank you. Works perfect. Your help is greatly appreciated.
Hopefully one day I will get a chance to sit down with a bigger project and learn more of the in and outs, rather than the odd little bit I am doing at the moment.
Thanks again.

[lucas]

FhM, be sure to mark your thread solved using the thread tools at the top of the page...

[FhM]

FhM, be sure to mark your thread solved using the thread tools at the top of the page...

Thanks for the heads up.

[digitalsage]

Would it be possible to modify this code set so that the script cycles through all cells of multiple tables within a document? I would like to do similar as posted above, but my case values are R(ed), Y(ellow), and G(reen), and the background color of the cell of the case value would be changed to the appropriate value.

The challenge I seem to be having is that the rows of the Word table(s) are irregular (one row might have a single cell, the next might have 5 cells).

:banghead:

Thanks in advance!

[macropod]

Hi digitalsage,

Would it be possible to modify this code set so that the script cycles through all cells of multiple tables within a document?
The code already cycles through all rows in all tables. Did you try it?

The first version of the sub I posted was coded to work on Column A only. To get the code to work on all cells, change:
For Each oCel In oTbl.Columns(1).Cells
to:
For Each oCel In oTbl.Range.Cells

You'll probably also want to change:
.BackgroundPatternColorIndex = wdDarkYellow
to:
.BackgroundPatternColorIndex = wdYellow

[digitalsage]

I've given your code and some other snippets I found online a try. While I have experience coding in the past, little of it has been VBA so I'm trying to grok the object model used.

Here's the code I have right now. I added a MsgBox for debug purposes, to validate that all of the cells are touched (they are). I noted that an end character (CR/LF?) was hidden at the end of the cell text, which accounts for the Left statement, as I thought it was causing the Case statement not to match properly.


Private Sub CommandButton1_Click()

Dim oTbl As Table
Dim oCel As Cell
Dim oText As String

For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Range.Cells
oText = Left(oCel.Range.Text, Len(oCel.Range.Text) - 1)

MsgBox oText

Select Case oText
Case "R"
oCel.Shading.BackgroundPatternColorIndex = wdRed
Case "Y"
oCel.Shading.BackgroundPatternColorIndex = wdYellow
Case "G"
oCell.Shading.BackgroundPatternColorIndex = wdGreen

End Select
Next
Next

End Sub


Unfortunately, none of the cell background colors change (not even incorrect cells).

[digitalsage]

Macropod, thanks so much for your help. Here is the code I used (this is assigned to a button within a Word doc):


Private Sub CommandButton1_Click()
Dim oTbl As Table
Dim oCel As Cell
Dim oRng As Range
For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Range.Cells
Set oRng = oCel.Range
oRng.End = oRng.End - 1

Select Case oRng.Text
Case "R"
oCel.Shading.BackgroundPatternColorIndex = wdRed
Case "Y"
oCel.Shading.BackgroundPatternColorIndex = wdYellow
Case "G"
oCel.Shading.BackgroundPatternColorIndex = wdGreen
End Select

Next
Next
End Sub

[FhM]

Dont use " I know you do normally is most languages but in this case in your code you are literally looking for "R" and not just R