VBA/Excel/Access/Word/Excel/Cell Format

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>