Coloring cells in a selected Word Doc Table based on cell values-CodePudding

Firstly, I have seen other questions phrased like this which are not asking the same thing. I am not repeating questions previously asked.

I have a table in Word that I have pasted numeric values into from an Excel spreadsheet. I would now like to color cells in that table based on their value. Ideally I would like it to be a range. For example, values falling between 5 and 7 are colored green, values above 7 are orange, and values below 5 are blue.

I am a beginner to VBA so the only place I can think to start is by selecting the table (it's the first in my document), using this:

Sub SelectTable()
'selects first table in active doc
    If ActiveDocument.Tables.Count > 0 Then    'to avoid errors
        ActiveDocument.Tables(1).Select
    End If
End Sub

I don't know if there is a way to cycle through the cells or whether you have to specify cell positions./ranges within the table. Any help is greatly appreciated.

Thanks!

CodePudding user response：

For example:

Sub TblDemo()
Application.ScreenUpdating = False
Dim x As Long, y As Variant
With ActiveDocument.Tables(1).Range
  For x = 1 To .Cells.Count
    With .Cells(x)
      y = Split(.Range.Text, vbCr)(0)
      If IsNumeric(y) Then
        Select Case y
          Case Is > 7: .Shading.BackgroundPatternColor = wdColorOrange
          Case 5 To 7: .Shading.BackgroundPatternColor = wdColorBrightGreen
          Case Is < 5: .Shading.BackgroundPatternColor = wdColorAqua
        End Select
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

CodePudding user response：

You have to loop through the rows, and loop through each cell in that row. Keep in mind that the Text value in that cell also contains the character.

Option Explicit

Sub ColorMe()
    Dim tbl As Table
    Set tbl = ThisDocument.Tables(1)
    
    Dim tblRow As Row
    Dim tblCell As Cell
    For Each tblRow In tbl.Rows
        For Each tblCell In tblRow.Cells
            If IsNumeric(OnlyText(tblCell.Range)) Then
                Dim cellValue As Long  'or Double?
                cellValue = CLng(OnlyText(tblCell.Range))
                If (cellValue < 5) Then
                    tblCell.Shading.BackgroundPatternColorIndex = wdBlue
                ElseIf ((cellValue >= 5) And (cellValue <= 7)) Then
                    tblCell.Shading.BackgroundPatternColorIndex = wdGreen
                ElseIf (cellValue > 7) Then
                    tblCell.Shading.BackgroundPatternColorIndex = wdRed
                End If
            End If
        Next tblCell
    Next tblRow
End Sub

Function OnlyText(ByVal text As Range) As String
    Dim result As String
    Dim character As Variant
    For Each character In text.Characters
        If (Asc(character) >= 33) And (Asc(character) <= 126) Then
            result = result & character
        End If
    Next character
    OnlyText = result
End Function