Clean up your Worksheet

In Which macro shortcut keys do you use I posted the code I use to clean up my worksheets. Since then I've revised the code somewhat. The fact that my computer crashed and I lost my personal.xls workbook had absolutely nothing to do with this decision.

*** Warning: This code overwrites formulas with their values. ***

Sub SetNormal()
  Dim visibleArea As Excel.Range
  Dim upperLeftCell As String
  Dim arrData() As Variant
  Dim arrReturnData() As Variant
  Dim numRows As Long
  Dim numCols As Long
  Dim i As Long, j As Long

  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
  End With

  Set visibleArea = ActiveSheet.UsedRange

  ' unfreeze panes, un-split
  With ActiveWindow
    .FreezePanes = False
    .Split = False
    .Zoom = 85
  End With

  With visibleArea
    ' reset font properties
    With .Font
      .Bold = False
      .Italic = False
      .Underline = False
      .Size = 10
      .Name = "Verdana"
      .ColorIndex = 0
    End With

    ' turn off filter mode (if any)
    ' http://www.contextures.com/xlautofilter03.html
    With .Parent
      If .FilterMode Then
        .ShowAllData
        .FilterMode = Not .FilterMode
      End If
    End With

    ' turn off autofilter
    .Parent.AutoFilterMode = False

    ' remove border lines (if any)
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone

    ' remove fill color
    .Interior.ColorIndex = xlNone

    ' trim cells
    numRows = .Rows.Count
    numCols = .Columns.Count
    ' size the input and output arrays
    ReDim arrData(1 To numRows, 1 To numCols)
    ReDim arrReturnData(1 To numRows, 1 To numCols)

    arrData = .Value

    For j = 1 To numCols
      For i = 1 To numRows
        arrReturnData(i, j) = Trim$(arrData(i, j))
      Next i
    Next j
    ' paste cleaned array into range
    .Value = arrReturnData

    upperLeftCell = .Cells(1, 1).Address

    If upperLeftCell = Range("A1").Address Then
      ' freeze pane, color the header row, add filter arrows
      With .Parent.Range(upperLeftCell & ":" & .Cells(1, 1).End(xlToRight).Address)
        .Interior.ColorIndex = 43
        .Font.ColorIndex = 2
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .AutoFilter
      End With

      ' freeze panes
      .Parent.Range(upperLeftCell).Offset(1, 0).Activate
      ActiveWindow.FreezePanes = True
    End If

    ' autofit
    .Columns.AutoFit
    .Rows.AutoFit
  End With

  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationAutomatic
  End With

End Sub

Since most of my worksheets are blocks of data with a header in row 1, this procedure has some hardcoding.

What it does

In no particular order, this code does the following:

• Trim all cells – adapted from Trimming cells, before and after
• Unfreeze and un-split worksheet (if applicable), set Zoom to 85%
• Remove fill and font colors, set font to Verdana size 10
• Turn off autofilter and remove arrows
• Remove border lines
• Freeze and color header row, add autofilter arrows
• Re-size all rows and columns

Now my worksheet is in perfect condition for lookups, formulas, data validation and filtering.

Do you do something different? Share your enhancements in the comments.