VBA Macro to Change Table Colors

Question

I have a Word document which contains several tables. I would like to be able to select the table (or a cell in the table) and have every row in the table be colored in alternating colors. So far, I have created the following code:

Sub ColorTable()
    '
    ' ColorTable Macro
    ' Alternately colors cells.
    '
    Selection.Collapse Direction:=wdCollapseStart
    If Not Selection.Information(wdWithInTable) Then
          MsgBox "Can only run this within a table"
          Exit Sub
    End If
    Dim RowCount, i, count, ColCount As Integer
    RowCount = ActiveDocument.Tables(1).Rows.count
    i = 0
    ColCount = ActiveDocument.Tables(1).Columns.count
    For i = 1 To RowCount
        For count = 1 To ColCount
            Selection.Shading.BackgroundPatternColor = RGB(184, 204, 228)
            'light
            Selection.MoveRight Unit:=wdCharacter, count:=1
        Next count
        Selection.MoveDown Unit:=wdLine, count:=1
        For count = 1 To ColCount
            Selection.Shading.BackgroundPatternColor = RGB(219, 229, 241)
            'dark
            Selection.MoveRight Unit:=wdCharacter, count:=1
        Next count
    Next i
End Sub

The Macro runs without errors, but changes the cell colors in a diagonal pattern. I'm guessing that the problem lies within my for loops.

Answer 1

With tblNew
  For i = 1 To .Rows.Count Step 2
    .Rows(i).Shading.Texture = wdTexture10Percent
       ' or
    .Rows(i).Shading.BackgroundPatternColor = RGB(219, 229, 241)
  Next
End With

Answer 2

After several months of not thinking about this problem, I found the answer.

Sub colorTable()
Dim rowCount As Integer
Dim colCount As Integer
Dim count As Integer
Dim row, col As Integer


Selection.Collapse Direction:=wdCollapseStart
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Can only be run from a table"
    Exit Sub
End If

rowCount = Selection.Tables(1).Rows.count - 1
colCount = Selection.Tables(1).Columns.count
row = 0
col = 0

While row < rowCount
   count = 1
     While col < colCount
        Selection.Shading.BackgroundPatternColor = RGB(182, 204, 228)
        If count < colCount Then
            Selection.MoveRight unit:=wdCell, count:=1
            count = count + 1
        End If
        col = col + 1
    Wend
    col = 0
    If row = rowCount - 1 And rowCount Mod 2 = 1 Then
        Exit Sub
    End If

    'dark
        Selection.MoveRight unit:=wdCell, count:=1
        count = 1
        'For Each oCOl In Selection.Tables(1).Columns
        While col < colCount
            Selection.Shading.BackgroundPatternColor = RGB(219, 229, 241)
            If count < colCount Then
                Selection.MoveRight unit:=wdCell, count:=1
                count = count + 1
            End If
            col = col + 1
        Wend
        row = row + 2
        If row < rowCount Then
            Selection.MoveRight unit:=wdCell, count:=1
        End If
        col = 0
Wend
End Sub

This probably isn't the best method, I just kind of kludged it together, but it works. I hope it helps somebody!

Answer 3

I haven't tested it yet, but i think you get the main idea

Sub ColorTable()
    Dim RowCount as Integer,s as String, row as Integer, ColCount As Integer
    RowCount = ActiveDocument.Tables(1).Rows.count
    ColCount = ActiveDocument.Tables(1).Columns.count
    For row = 1 To RowCount
        s=replace(Cell(row,1).Address,"$","")
        s=s & ":" & replace(Cell(row,ColCount).Address,"$","")
        Range(s).Shading.BackgroundPatternColor = iif(row mod 2 =0,RGB(184, 204, 228),RGB(219, 229, 241))
        Next count
    Next row
End Sub