VBA/Excel/Access/Word/Excel/Range Format

Add & format totals

   <source lang="vb">

Sub RigidFormattingProcedure()

   ActiveSheet.Range("N7:N15").Formula = "=SUM(RC[-12]:RC[-1])" 
   ActiveSheet.Range("N7:N15").Font.Bold = True 
   ActiveSheet.Range("B16:N16").Formula = "=SUM(R[-9]C:R[-1]C)" 
   ActiveSheet.Range("B16:N16").Font.Bold = True 

End Sub

   " Format data range 

Sub RigidFormattingProcedure()

   ActiveSheet.Range("B7:N16").NumberFormat = "#,##0" 

End Sub

</source>
   
  

Change range border color

   <source lang="vb">

Sub BorderDemo()

 With Range("A1:E5")
   .BorderAround ColorIndex:=1
 End With

End Sub

</source>
   
  

Change range border style

   <source lang="vb">

Sub Extend()

 With Range("A1:E5")
   .Borders.LineStyle = xlLineStyleNone
   .Resize(.Rows.Count + 1).Name = "Database"
 End With

End Sub

</source>
   
  

Changes color of numbers

   <source lang="vb">

Sub ColorCells1()

  Dim myRange As Range
  Dim i As Long, j As Long

  Set myRange = Range("A1:A5")
  For i = 1 To myRange.Rows.Count
     For j = 1 To myRange.Columns.Count
        If myRange.Cells(i, j).Value < 100 Then
           myRange.Cells(i, j).Font.ColorIndex = 3
        Else
           myRange.Cells(i, j).Font.ColorIndex = 1
        End If
     Next j
  Next i

End Sub

</source>
   
  

Changes font to bold

   <source lang="vb">

Sub Bold()

  Dim rngRow As Range
  For Each rngRow In Range("A1:E5").Rows
     If rngRow.Cells(1).Value > 1 Then
        rngRow.Font.Bold = True
     Else
        rngRow.Font.Bold = False
     End If
  Next rngRow

End Sub

</source>
   
  

Format current region

   <source lang="vb">

Sub FormatCurrentRegion()

   Set WorkRange = ActiveCell.CurrentRegion
   WorkRange.Font.Bold = True

End Sub

</source>
   
  

Format date on report

   <source lang="vb">

Sub RigidFormattingProcedure()

   ActiveSheet.Range("A2").NumberFormat = "mmm-yy" 

End Sub

</source>
   
  

Formatting Range: Font

   <source lang="vb">

    Sub InsertHeader()
        Range("A1:C1").Select
        With Selection.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 14
        End With
    End Sub
</source>
   
  

Formatting Range: HorizontalAlignment, VerticalAlignment, MergeCells

   <source lang="vb">

    Sub InsertHeader()
        Range("A1:C1").Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .MergeCells = True
        End With
    End Sub
</source>
   
  

Line style: xlContinuous

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous 
   Set rg = Nothing 

End Sub

</source>
   
  

Line style: xlDash

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDash
   Set rg = Nothing 

End Sub

</source>
   
  

Line style: xlDashDot

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDashDot
   Set rg = Nothing 

End Sub

</source>
   
  

Line style: xlDashDotDot

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDashDotDot
   Set rg = Nothing 

End Sub

</source>
   
  

Line style: xlDot

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDot
   Set rg = Nothing 

End Sub

</source>
   
  

Line style: xlDouble

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDouble
   Set rg = Nothing 

End Sub

</source>
   
  

Line style: xlLineStyleNone

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
   Set rg = Nothing 

End Sub

</source>
   
  

Line style: xlSlantDashDot

   <source lang="vb">

Sub BorderLineSytlesII()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") 
   rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlSlantDashDot
   Set rg = Nothing 

End Sub

</source>
   
  

Make column headings bold

   <source lang="vb">

Sub RigidFormattingProcedure()

   ActiveSheet.Range("6:6").Font.Bold = True 

End Sub

</source>
   
  

Make text in first column bold

   <source lang="vb">

Sub RigidFormattingProcedure()

   ActiveSheet.Range("A:A").Font.Bold = True 

End Sub

</source>
   
  

Providing Dynamic Scaling to Your Worksheets

   <source lang="vb">

Private Sub Worksheet_Change(ByVal Target As Range)

   If Target.Address = Me.Range("ScaleFactor").Address Then 
       ScaleData 
   End If 

End Sub Private Sub ScaleData()

   If Me.Range("ScaleFactor").Value = "Normal" Then 
       Me.Range("ScaleRange").NumberFormat = "#,##0" 
   Else 
       Me.Range("ScaleRange").NumberFormat = "#," 
   End If 

End Sub

</source>
   
  

Sets to True the Bold property of the Font object contained in the Range object

   <source lang="vb">

Sub bold()

   range("A1").font.bold = True

End Sub

</source>
   
  

Set the color for whole range

   <source lang="vb">

Sub ColorCells4()

  Dim Rng As Range
 
  For Each Rng In Range("A1:E5")
     If Rng.Value < 100 Then
        Rng.Font.ColorIndex = 4
     Else
        Rng.Font.ColorIndex = 1
     End If
  Next Rng

End Sub

</source>
   
  

Set the underline, color and font name

   <source lang="vb">

Sub DemonstrateFontObject()

   Dim nColumn As Integer 
   Dim nRow As Integer 
   Dim avFonts As Variant  
   Dim avColors As Variant 
   avFonts = Array("Tahoma", "Arial", "MS Sans Serif", "Verdana", "Georgia") 
   avColors = Array(vbRed, vbBlue, vbBlack, vbGreen, vbYellow) 
   For nRow = 1 To 5 
       With ThisWorkbook.Worksheets(1).Rows(nRow).Font 
           .Color = avColors(nRow - 1) 
           .Name = avFonts(nRow - 1) 
           If nRow Mod 2 = 0 Then 
               .Underline = True 
           Else 
               .Underline = False 
           End If 
       End With 
   Next 

End Sub

</source>
   
  

Specify colors with VBA"s RGB function.

   <source lang="vb">

Sub rgbDemo()

   range("A1").Interior.color = rgb(0, 0, 0) "black
   range("A2").Interior.color = rgb(255, 0, 0) " pure red
   range("A3").Interior.color = rgb(0, 0, 255) " pure blue
   range("A4").Interior.color = rgb(128, 128, 128) " middle gray

End Sub

</source>
   
  

Strolling Through the Color Palette

   <source lang="vb">

Sub ViewWorkbookColors()

   Dim rg As Range 
   Dim nIndex As Integer 
   Set rg = ThisWorkbook.Worksheets("Sheet1").Range("A1:E5").Offset(1, 0) 
   For nIndex = 1 To 56 
       rg.Value = nIndex 
       rg.Offset(0, 1).Interior.ColorIndex = nIndex 
       rg.Offset(0, 2).Value = rg.Offset(0, 1).Interior.Color 
       Set rg = rg.Offset(1, 0) 
   Next 
   Set rg = Nothing 

End Sub

</source>
   
  

The Font property

   <source lang="vb">

Sub font()

   Debug.Print range("A1").font.Background
   

End Sub

</source>
   
  

The Interior property:changes the Color property of the Interior object contained in the Range object:

   <source lang="vb">

Sub color()

   range("A1").Interior.color = 8421504

End Sub

</source>
   
  

Use the Range and Cells properties of the Worksheet object to return a Range object.

   <source lang="vb">

Sub rangeColor()

   Range("A:B").Font.Color = vbRed

End Sub

</source>
   
  

Using the Interior Object to Alter the Background of a Range

   <source lang="vb">

Sub InteriorExample()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Sheet1").Range("A1").Offset(1, 0) 
   Do Until IsEmpty(rg) 
       rg.Offset(0, 2).Interior.Pattern = rg.Offset(0, 1).Value 
       rg.Offset(0, 3).Interior.Pattern = rg.Offset(0, 1).Value 
       rg.Offset(0, 3).Interior.PatternColor = vbRed 
       Set rg = rg.Offset(1, 0) 
   Loop 
   " create examples of each VB defined color constant 
   Set rg = ThisWorkbook.Worksheets("Sheet1").Range("A1:E3").Offset(1, 0) 
   Do Until IsEmpty(rg) 
       rg.Offset(0, 2).Interior.Color = rg.Offset(0, 1).Value 
       Set rg = rg.Offset(1, 0) 
   Loop 
   Set rg = Nothing 

End Sub

</source>
   
  

Widen first column to display text

   <source lang="vb">

Sub RigidFormattingProcedure()

   ActiveSheet.Range("A:A").EntireColumn.AutoFit 

End Sub

</source>