conditional formatting of filling/shading of a cell based on 5 numerical rulesWord'07

[spacebase150]

Hi everyone! I am new here and I need some help with some tedious work. This will save me hours of my life.

I am stuck using Microsoft Word 2007.

I need to color the numbers in these tables. I need to shade each cell a certain color based off of the number contained within. The numbers are always 1 to 5 and are always the the hundreths decimal place. This will always be a 7 by 12 area that needs the coloring. Please see the example below of the shaded cells coloring based on the numbers contained (I have to shade each cell manually :crying:).

The rules for the color of the filling of the shaded cell are:

<1.8 green
1.8<= light green < 2.6
2.6<= white/clear <3.4
3.4<= salmon <4.2
<4.2 red

The VBA doesn't have to be automatic. I can manually run the macro/code each time. I believe the whole table is 11X12 but I only need the areas with the numbers colored which is 7 X 12 (see image below)

Thank you so much

11068

[gmaxey]

Spaceman,

You will have to put the cursor in the table to process and define the correct RGB values you need:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oCell As Cell
Dim sngVal As Single
For Each oCell In Selection.Tables(1).Range.Cells
If IsNumeric(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)) Then
sngVal = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
If sngVal < 1.8 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(0, 0, 255)
ElseIf sngVal >= 1.8 And sngVal < 2.6 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ElseIf sngVal >= 2.6 And sngVal < 3.4 Then

ElseIf sngVal >= 3.4 And sngVal < 4.2 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ElseIf sngVal < 4.2 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(255, 0, 255)
End If
End If
Next
End Sub

[spacebase150]

Spaceman,

You will have to put the cursor in the table to process and define the correct RGB values you need:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oCell As Cell
Dim sngVal As Single
For Each oCell In Selection.Tables(1).Range.Cells
If IsNumeric(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)) Then
sngVal = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
If sngVal < 1.8 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(0, 0, 255)
ElseIf sngVal >= 1.8 And sngVal < 2.6 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ElseIf sngVal >= 2.6 And sngVal < 3.4 Then

ElseIf sngVal >= 3.4 And sngVal < 4.2 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ElseIf sngVal < 4.2 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(255, 0, 255)
End If
End If
Next
End Sub



Greg,

I cannot begin to thank you. This is so helpful and I am so thankful for you to take the time to make my life easier. You truly are a master of your craft. It worked flawlessly exactly like I needed. Thank you. Please let me know anything I can do, like a good rating or something. Blessings.


P.S. ElseIf sngVal > 4.2 Then
oCell.Range.Shading.BackgroundPatternColor = RGB(255, 0, 255)

I switched around the sign to get it to work exactly how I wanted here. Thank you!

Best,

Spacebase

[gmaxey]

Spacebase,

Glad I could help.