Word vba cell color

Join Tek-Tips^® Today!

Join your peers on the Internet’s largest technical computer professional community.
It’s easy to join and it’s free.

Here’s Why Members Love Tek-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More…

Register now while it’s still free!

Already a member? Close this window and log in.

Join Us             Close

Color cells

   <source lang="vb">

Public Sub ColorCells()

 Dim Sales As Range
 Dim i As Long
 Dim j As Long
 
 Set Sales = Range("SalesData")
 For i = 1 To Sales.Rows.Count
   For j = 1 To Sales.Columns.Count
     If Sales.Cells(i, j).Value < 100 Then
       Sales.Cells(i, j).Font.ColorIndex = 3
     Else
       Sales.Cells(i, j).Font.ColorIndex = 1
     End If
   Next j
 Next i

End Sub

</source>
   
  

Coloring all negative cells» backgrounds red

   <source lang="vb">

Sub SelectiveColor1()

   If TypeName(Selection) <> "Range" Then Exit Sub
   Const REDINDEX = 3
   Application.ScreenUpdating = False
   For Each Cell In Selection
       If Cell.value < 0 Then
         Cell.Interior.ColorIndex = REDINDEX
       Else
         Cell.Interior.ColorIndex = xlNone
       End If
   Next Cell

End Sub

</source>
   
  

Color multiple-column ranges

   <source lang="vb">

Sub SelectiveColor2()

   Dim FormulaCells As range
   Dim ConstantCells As range
   Const REDINDEX = 3
   On Error Resume Next
   Application.ScreenUpdating = False
   Set FormulaCells = Selection.SpecialCells(xlFormulas, xlNumbers)
   Set ConstantCells = Selection.SpecialCells(xlConstants, xlNumbers)
   For Each Cell In FormulaCells
       If Cell.value < 0 Then _
         Cell.Font.ColorIndex = REDINDEX
   Next Cell
   For Each Cell In ConstantCells
       If Cell.value < 0 Then
          Cell.Interior.ColorIndex = REDINDEX
       Else
          Cell.Interior.ColorIndex = xlNone
       End If
   Next Cell

End Sub

</source>
   
  

Make a Cell font bold based on the cell value

   <source lang="vb">

Sub valueDemo()

    If ActiveCell.value = 10 Then
       ActiveCell.font.bold = True
    End If

End Sub

</source>
   
  

Makes cell background red if the value is negative

   <source lang="vb">

Sub SelectiveColor2()

   Dim FormulaCells As Range
   Dim ConstantCells As Range
   Const REDINDEX = 3
   On Error Resume Next
   Application.ScreenUpdating = False
   Set FormulaCells = Selection.SpecialCells (xlFormulas, xlNumbers)
   Set ConstantCells = Selection.SpecialCells (xlConstants, xlNumbers)
   For Each cell In FormulaCells
       If cell.Value < 0 Then _
         cell.Font.ColorIndex = REDINDEX
   Next cell
   For Each cell In ConstantCells
       If cell.Value < 0 Then
          cell.Interior.ColorIndex = REDINDEX
       Else
          cell.Interior.ColorIndex = xlNone
       End If
   Next cell

End Sub

</source>
   
  

Make the font in number cell bold

   <source lang="vb">

Sub BoldNCRows()

 Dim rngRow As Range
 For Each rngRow In Cells.SpecialCells(xlCellTypeConstants, xlNumbers).Rows
   rngRow.Font.Bold = True
 Next rngRow

End Sub

</source>
   
  

Removes all borders for the selected cells

   <source lang="vb">

Sub RemoveAllBorders()

 Dim calcModus&, updateModus&, i
 Dim rng As Range, ar As Range
 Dim brd As Border
 If Selection Is Nothing Then Exit Sub
 
 calcModus = Application.Calculation
 updateModus = Application.ScreenUpdating
 Application.Calculation = xlManual
 Application.ScreenUpdating = False
 For Each ar In Selection.Areas   
   For Each rng In ar             
     For Each i In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp)
       rng.Borders(i).LineStyle = xlLineStyleNone
     Next i
     If rng.Column > 1 Then
       rng.Offset(0, -1).Borders(xlRight).LineStyle = xlLineStyleNone
     End If
     If rng.Column < 256 Then
        rng.Offset(0, 1).Borders(xlLeft).LineStyle = xlLineStyleNone
     End If
     If rng.Row > 1 Then
       rng.Offset(-1, 0).Borders(xlBottom).LineStyle = xlLineStyleNone
     End If
     If rng.Row < 65536 Then
        rng.Offset(1, 0).Borders(xlTop).LineStyle = xlLineStyleNone
     End If
   Next rng
 Next ar
 Application.Calculation = calcModus
 Application.ScreenUpdating = updateModus

End Sub

</source>
   
  

Set cell color

   <source lang="vb">

Sub Set_Protection()

   On Error GoTo errorHandler
   Dim myDoc As Worksheet
   Dim cel As Range
   Set myDoc = ActiveSheet
   myDoc.Unprotect
   For Each cel In myDoc.UsedRange
       cel.Locked = True
       cel.Font.ColorIndex = xlColorIndexAutomatic
   Next
   myDoc.Protect
   Exit Sub
   errorHandler:
   MsgBox Error

End Sub

</source>
   
  

Set data to cell D1 of the selected worksheet. And format its contents with color and borders.

   <source lang="vb">

Sub cmd()

   Cells(1, "D").Value = "Text"
   Cells(1, "D").Select
   
   With Selection
       .Font.Bold = True
       .Font.Name = "Arial"
       .Font.Size = 72
       .Font.Color = RGB(0, 0, 255)  "Dark blue
       .Columns.AutoFit
       .Interior.Color = RGB(0, 255, 255) "Cyan
       .Borders.Weight = xlThick
       .Borders.Color = RGB(0, 0, 255)  "Dark Blue
   End With

End Sub

</source>
   
  

Sets just the color of cell C1 to red.

   <source lang="vb">

Sub cellFont()

   Cells(1, "C").Font.Color = vbRed

End Sub

</source>
   
  

the font color of all cells in the active worksheet is set to red

   <source lang="vb">

Sub fontColor()

   Cells.Font.Color = vbRed

End Sub

</source>

Word VBA always has refused to deal with rows in a table that contains vertically merged cells, or with columns in a table that contains horizontally merged cells. If your table has only vertically merged cells, you can run the For Each on the columns instead of the rows, like this:

Sub test()
    Dim tbl As Table
    Dim col As Column
    Dim cel As Cell
    
    For Each tbl In ActiveDocument.Tables
        For Each col In tbl.Columns
            For Each cel In col.Cells
                If cel.Shading.BackgroundPatternColor = RGB(225, 225, 153) Then
                    cel.Shading.BackgroundPatternColor = RGB(225, 225, 225)
                End If
            Next cel
        Next col
    Next tbl
End Sub

Another alternative is to go through all cells in the table’s Range, like this:

Sub test()
    Dim tbl As Table
    Dim cel As Cell
    
    For Each tbl In ActiveDocument.Tables
        For Each cel In tbl.Range.Cells
            If cel.Shading.BackgroundPatternColor = RGB(225, 225, 153) Then
                cel.Shading.BackgroundPatternColor = RGB(225, 225, 225)
            End If
        Next cel
    Next tbl
End Sub

Either way, you could run into this problem: If the RGB(225, 225, 153) shading was applied after the cells were merged, then VBA will tell you that the BackgroundPatternColor of the merged cells is -1 instead of the actual RGB value, and the If statement will see the condition as False. That happens because only one of the cells that were merged together has the shading you expect, and the others are not shaded. The only way to avoid that is to unmerge, shade all of the cells that will be included, and then merge them again.