CODEWITHSUNDEEP
vbams-word
PMC11
PMC11

Reputation: 13

Change Text Colour in Cell Based on Text in Same Cell - Word VBA

I am new to VBA so I am struggling with what seems to be quite a simple task.

I have a few lines of text in each cell in a word document. Each cell contains a category such "Science" or "Health" or one of several others. At the minute I'm actually just using a special character such as "*" or "@" for testing purposes.

I need the text colour of all text in the cell to change depending on which category is in the cell. So the txt would be e.g. green for "Science" and red for "Health".

It seems that running a macro is quickest way of making these changes (there will be over 200 such cells in my final document and colouring manually is such a waste of time). Basically, I'm struggling with first changing the colour of all the text in the cell, and secondly how to make the macro search again if the first criteria is not met. I would like 1 macro that could complete colouring for the entire document, rather than having multiple macros for each colour I need.

If you could give me some examples of VBA I could work with that would be most helpful. I'm really struggling and any help you could give will save me and my team so much time.

Upvotes: 1

Views: 1435

Answers (1)

Dick Kusleika
Dick Kusleika

Reputation: 33145

This should perform reasonably well unless your document is huge or your keyword list is huge or both. 

Sub ColorCells()

    Dim tbl As Table
    Dim rw As Row
    Dim cll As Cell
    Dim i As Long
    Dim Keywords As Variant, Colors As Variant

    'if you have more than one table, you have to look through them
    Set tbl = ThisDocument.Tables(1)

    'Make two arrays - one with keywords and the second with colors
    'where the colors are in the same position in their array as the
    'keywords are in theirs
    Keywords = Array("Science", "Health")
    Colors = Array(wdBlue, wdDarkRed)

    'Loop through every row in the table
    For Each rw In tbl.Rows
        'Loop through every cell in the row
        For Each cll In rw.Cells
            'Loop through every keyword in your array
            For i = LBound(Keywords) To UBound(Keywords)
                'if the keyword exist, change the color and stop checking
                'further keywords
                If InStr(1, cll.Range.Text, Keywords(i)) > 0 Then
                    cll.Range.Font.ColorIndex = Colors(i)
                    Exit For
                End If
            Next i
        Next cll
    Next rw

End Sub

If you want to use custom colors instead of built in ones, change the Colors array assignment line to 

Colors = Array(RGB(192, 192, 192), RGB(188, 25, 67))

and the line where you set the color to

cll.Range.Font.TextColor.RGB = Colors(i)

Upvotes: 1

Related Questions