loop through tables in word and change color of cells

[Spitale]

Hello forum,
I would like to have suggestions on how to change color in tables using VBA. The word file has many tables but all have the same structure, only the contents change. I need a macro which changes the background color of the cells according to the contents. So for example, if the cell contains the text "I" then I want that cell colored in blue, if insted it contains "V" then it should be red and so on for 8 different classes. The following is the macro I modified (the original one was developed by someone else) but when I run it nothing happen, and I don't understand where I'm wrong.
Thank you for any help!
Daniel


Sub colora()
Dim MyTable As Table
Dim MyRow As Row
Dim MyCell As Cell
For Each MyTable In ActiveDocument.Tables
For Each MyRow In MyTable.Rows
For Each MyCell In MyRow.Cells
If MyCell.Range.Text = "I" Then
MyCell.Shading.BackgroundPatternColor = wdColorBlue
ElseIf MyCell.Range.Text = "V" Then
MyCell.Shading.BackgroundPatternColor = wdColorRed
End If
Next MyCell
Next MyRow
Next MyTable
Set MyCell = Nothing
Set MyRow = Nothing
Set MyTable = Nothing
End Sub


Please note the crossposting below with the same question but differently formulated
https://groups.google.com/g/microsoft.public.word.tables/c/YLWdSId_14k

[gmaxey]

Sub colora()
Dim MyTable As Table
Dim MyRow As Row
Dim MyCell As Cell
For Each MyTable In ActiveDocument.Tables
For Each MyCell In MyTable.Range.Cells
If InStr(MyCell.Range.Text, "I") > 0 Then
MyCell.Shading.BackgroundPatternColor = wdColorBlue
ElseIf InStr(MyCell.Range.Text, "V") > 0 Then
MyCell.Shading.BackgroundPatternColor = wdColorRed
End If
Next MyCell
Next MyTable
Set MyCell = Nothing: Set MyTable = Nothing
End Sub

[Spitale]

Thank you Greg for you quick reply!
It works but not as expected. If in the cell I have for example "IV" (or IV), the cell is colored in blue, but this should not be the case. I want the cell blue if and only if, the string is "I".
Thank you for any additional comments,
best wishes from Italy

[macropod]

Try:

Sub Colora()
Application.ScreenUpdating = False
Dim MyTable As Table, MyCell As Cell, BkGrnd As Long
For Each MyTable In ActiveDocument.Tables
For Each MyCell In MyTable.Range.Cells
Select Case Split(MyCell.Range.Text, vbCr)(0)
Case "I": BkGrnd = wdColorBlue
Case "V": BkGrnd = wdColorRed
Case Else: BkGrnd = wdColorAutomatic
End Select
MyCell.Shading.BackgroundPatternColor = BkGrnd
Next MyCell
Next MyTable
Set MyCell = Nothing: Set MyTable = Nothing
Application.ScreenUpdating = True
End Sub

[gmaxey]

You haven't explained the situation that well. What if the cell contains "I don't understand" or "V for victory" do you still want the cell color, or only if the full content is "I" or "V"


Sub Colora()
Dim MyTable As Table, MyCell As Cell
For Each MyTable In ActiveDocument.Tables
For Each MyCell In MyTable.Range.Cells
With MyCell
Select Case Left(.Range.Text, Len(.Range.Text) - 2)
Case "I": .Shading.BackgroundPatternColor = wdColorBlue
Case "V": .Shading.BackgroundPatternColor = wdColorRed
Case "VI": .Shading.BackgroundPatternColor = wdColorBrightGreen
Case Else: .Shading.BackgroundPatternColor = wdColorAutomatic
End Select
End With
Next MyCell
Next MyTable
Set MyCell = Nothing: Set MyTable = Nothing
lbl_Exit:
Exit Sub
End Sub

[Spitale]

Dear Paul and Greg,
thank you both. The solution by Paul places the color on each cell containing "I" but also if the cell contains somenthing like "Items", and I don't want this. The cell should be colored only if it contains "I".
The last solution by Greg provides the expected result. However, I wonder why the macro is so slow, it takes 2-3 seconds to process a table with 60 cells. Is that normal?
Thank you again,
best regards
Daniel

[macropod]

The solution by Paul places the color on each cell containing "I" but also if the cell contains somenthing like "Items"
No, it does not. The code finds cells whose first (only) paragraph contains only I or V - changing them as per your specifications - plus resetting the background colour of any cells that contain anything other than only I or V. Greg's does essentially the same thing, except that it allows for the possibility there might be multiple paragraphs in the cell.

My code should work slightly quicker than Greg's, because it turns off screen updating while running. A Find/Replace would likely be quicker still:

Sub Demo()Application.ScreenUpdating = False
Dim Rng As Range, BkGrnd As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<[IV]>"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
If .Information(wdWithInTable) = True Then
Set Rng = .Cells(1).Range
With Rng
.End = .End - 1
Select Case .Text
Case "I": BkGrnd = wdColorBlue
Case "V": BkGrnd = wdColorRed
End Select
.Cells(1).Shading.BackgroundPatternColor = BkGrnd
End With
End If
.Collapse wdCollapseEnd
Loop
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[Spitale]

Thank you Paul, now the application is a bit faster even though less clear to understand for a newbie like me. When I approached the problem seemed quite easy to solve but soon has become difficult. Thank you also for the explanation, I did not think about all the possible options.
Best wishes
Daniel

[macropod]

The "less clear to understand" probably relates to the Find expression, which is a wildcard Find for words consisting of the single character I or V. For more details, see: Finding and replacing characters using wildcards (wordmvp.com) (https://wordmvp.com/FAQs/General/UsingWildcards.htm)

[Spitale]

Dear Paul and Greg,
I would like to modify a bit the code to accomodate more than two cases. However, once I added the cases, the code still colors only the I and V as in the original solution. What I'm doing wrong?
Thank you
Daniel


Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, BkGrnd As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<[IV]>"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
If .Information(wdWithInTable) = True Then
Set Rng = .Cells(1).Range
With Rng
.End = .End - 1
Select Case .Text
Case "I": BkGrnd = RGB(0, 112, 192)
Case "I-II": BkGrnd = RGB(155, 194, 230)
Case "II": BkGrnd = RGB(0, 176, 80)
Case "II-III": BkGrnd = RGB(146, 208, 80)
Case "III": BkGrnd = RGB(255, 255, 0)
Case "III-IV": BkGrnd = RGB(255, 230, 153)
Case "IV": BkGrnd = RGB(255, 192, 0)
Case "IV-V": BkGrnd = RGB(244, 176, 132)
Case "V": BkGrnd = RGB(255, 0, 0)
Case Else: BkGrnd = wdColorAutomatic
End Select
.Cells(1).Shading.BackgroundPatternColor = BkGrnd
End With
End If
.Collapse wdCollapseEnd
Loop
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[macropod]

As I said in post #9:
The "less clear to understand" probably relates to the Find expression, which is a wildcard Find for words consisting of the single character I or V. For more details, see: Finding and replacing characters using wildcards (wordmvp.com)
(emphasis added)


Accordingly. you need to use a Find expression that finds all the combinations you're interested in. You can do that by changing:
.Text = "<[IV]>"
to:
.Text = "<[IV\-]{1,}>"

[Spitale]

Hello Paul, thank you for the response. I changed that part as suggested but I encountered and error, it says "the text in the Find cell contains an invalid expression". I'm using word 2016. I read wildcards documentation without finding the answer. Could you help me once more? Thank you
Daniel

[macropod]

That suggests you're using a system with non-English regional settings. Change:
.Text = "<[IV\-]{1,}>"
to:
.Text = "<[IV\-]{1;}>"

[Spitale]

Now it works perfectly, and it is also relatively fast! Thank you so much!
Daniel