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.

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »


Related Articles:


Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

comment bubble 3 Comment(s) on Clean up your Worksheet:

  1. Bill McNair writes:

    Just out of curiosity, is there some macro code that would check in all open VBA code files (including "xla" files) for macros assigned a keystroke shortcut, then add a new sheet with a table of the names of the macros with key stroke shortcuts (col 1), then the name of the VBA module where the macro that has been assigned a key stroke shortcut resides (col 2) and the keys stroke combination assigned to the macro (col 3)? -bill

  2. I didn't know you could remove formatting (bold, italic), change fonts, and background color, etc. over the entire range all at once. I guess I really never thought about it. Awesome, nonetheless. Thanks for sharing the code.

This article is closed to any future comments.
Random Data Generator