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

Add & format totals

 
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

Change range border color

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

Change range border style

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

Changes color of numbers

 
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

Changes font to bold

 
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

Format current region

 
Sub FormatCurrentRegion()
    Set WorkRange = ActiveCell.CurrentRegion
    WorkRange.Font.Bold = True
End Sub

Format date on report

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

Formatting Range: Font

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

Formatting Range: HorizontalAlignment, VerticalAlignment, MergeCells

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

Line style: xlContinuous

 
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

Line style: xlDash

 
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

Line style: xlDashDot

 
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

Line style: xlDashDotDot

 
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

Line style: xlDot

 
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

Line style: xlDouble

 
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

Line style: xlLineStyleNone

 
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

Line style: xlSlantDashDot

 
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

Make column headings bold

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

Make text in first column bold

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

Providing Dynamic Scaling to Your Worksheets

 
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

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

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

Set the color for whole range

 
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

Set the underline, color and font name

 
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

Specify colors with VBA"s RGB function.

 
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

Strolling Through the Color Palette

 
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

The Font property

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

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

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

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

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

Using the Interior Object to Alter the Background of a Range

 
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

Widen first column to display text

 
Sub RigidFormattingProcedure() 
    ActiveSheet.Range("A:A").EntireColumn.AutoFit 
End Sub