Code & Hacks by Mark Grimes

I finally created an add-in for Excel that includes many of the tools that I use all the time and have outlined on this site. The add-in will create a new menu in Excel and setup a number of shortcuts. Here are some of the more useful ones:

• Ctrl-Shift-C - Automatically color selected cells based on their content (values=blue, formula=black, ref to another sheet=green, offset=red)
• Ctrl-Shift-U - Toggle an underline for the selected cells
• Ctrl-Shift-O - Toggle an overline for the selected cells
• Ctrl-Shift-A - Toggle center (Align) across the selected cells
• Ctrl-Shift-V - Paste just values
• Conditional Deletes - Delete any cell/row from the current selection that is a duplicate of the prior cell
• Format selected cells as multiples (ie, "4.75x") - A toolbar button is added to the format toolbar

To install:

1. Close Excel
2. Save the file MVG-Code.xla in C:\Documents and Settings\your-user-id\Application Data\Microsoft\AddIns
3. Open Excel back up, if you have the "Action" menu after "Help", then you are done. If not, go on to 4.
4. Go to Tools->Add-Ins and put a check mark by "MVG Custom Macros". If you don't see it in the list, click "Browse" and select MVG-Code.xla. Click OK and you should see a new "Actions" menu.

Hope someone finds these useful. I have been using these for years without any issues, but please let me know if you run into problems.

I recently switched to a Mac and really miss my auto color cells VBA script for Excel. After quite a bit of digging (and trial-and-error) I managed to recreate the functionality using AppleScript. It is pretty slow, but it works!

Just like the VBA version, this automatically color codes cells to help identify inputs, formulas, etc. For example, cells that contain only numbers are colored blue, all formulas black, references to other workbooks are green and cells that include the =OFFSET() function (what I use for setting up different scenarios) are rust.

Open up the AppleScript Editor, paste the following code and save it as /Users/<your-username>/Documents/Microsoft User Data/Excel Script Menu Items/AutoColorCells\scc.scpt. The \scc in the filename creates a keyboard shortcut control-shift-c.

tell application "Microsoft Excel"
    --activate
    set colStart to (get first column index of selection)
    set rowStart to (get first row index of selection)
    set colCount to (get count columns of selection)
    set rowCount to (get count rows of selection)

    set status bar to "Auto coloring the cells"
    set screen updating to false

    repeat with i from rowStart to rowStart + rowCount - 1
        set status bar to "Row " & i - rowStart + 1 & " of " & rowCount
        repeat with j from colStart to colStart + colCount - 1
            --set theCell to cell j of row i
            --set f2 to (get formula of theCell)
            set f to (get formula of cell j of row i)

            if f starts with "=" then
                if f contains ".xls" then
                    set font color index of font object of cell j of row i to 10 -- rust
                else if f contains "OFFSET" then
                    set font color index of font object of cell j of row i to 9 -- green
                else if my isallnumbers(f) then
                    set font color index of font object of cell j of row i to 5 -- blue
                else
                    set font color index of font object of cell j of row i to 1 -- auto
                end if
            else
                if my isallnumbers(f) then
                    set font color index of font object of cell j of row i to 5 -- blue
                else
                    set font color index of font object of cell j of row i to 0 -- auto
                end if
            end if
        end repeat
    end repeat

    set screen updating to true
    set status bar to "Auto Color Done"

end tell

to isallnumbers(f)
    set l to length of f

    --log_event("f is " & f) of my commonScript

    repeat with k from 1 to l
        set c to ASCII number of character k of f
        if c < 40 or c > 61 then
            return false
        end if
    end repeat
    return true
end isallnumbers

Rather than merging cells to center headers, I prefer to have text centered across selection. This avoids problems with deleting and filling columns that are cosed by merged cells. The following sets up a command to toggle centering across columns.

Open up the AppleScript Editor, paste the following code and save it as /Users/<your-username>/Documents/Microsoft User Data/Excel Script Menu Items/AlignCentered\sca.scpt. The \sca in the filename creates a keyboard shortcut control-shift-a.

-- Align selected cells across selection
-- Copyright under GPL by Mark Grimes
-- Saving with '\sca' in the filename creates Shortcut: Crtl+Shift+a

tell application "Microsoft Excel"
    --activate
    tell range (get address selection) of active sheet
        if (get count columns) > 1 or (get count rows) > 1 then
            if (get horizontal alignment) is horizontal align center across selection then
                set horizontal alignment to horizontal align general
            else
                set horizontal alignment to horizontal align center across selection
            end if
        else
            if (get horizontal alignment) is horizontal align center then
                set horizontal alignment to horizontal align general
            else
                set horizontal alignment to horizontal align center
            end if
        end if
    end tell
end tell

Here is another AppleScript version of a [excel.html#backup](prior vba) script. This one creates a back of the current workbook. It copies the last saved version of the current workbook to a Backup subdirectory below the directory in which that file was saved. It adds a counter (ie, .001) before the .xls(x) extension.

-- Save a backup of the current file
-- Copyright under GPL by Mark Grimes
-- Saving with '\scs' in the filename creates Shortcut: Crtl+Shift+S

tell application "Microsoft Excel"
    set macPath to get full name of (get properties of active workbook)
    set curPath to my posix_path(macPath)
    set cmdStatus to do shell script ¬
        "perl -MFile::Copy -MFile::Basename -MFile::Spec -e' " & ¬
        "$f=qq{" & curPath & "}; " & ¬
        "$d = File::Spec->catdir(dirname($f),q{Backup});" & ¬
        "mkdir $d unless -d $d;" & ¬
        "$b = File::Spec->catfile($d,basename($f)); " & ¬
        "$i=1;" & ¬
        "do {$s = sprintf( qq{%03d}, $i++); $b=~s/(?:.\\d{3})?.(xlsx?)$/.$s.$1/; }" & ¬
        "  while( -e $b );" & ¬
        "copy $f, $b or die qq{Error copying $f to $b: $!};" & ¬
        "print qq{Backed up last saved version to: $b};" & ¬
        " ' "
    display dialog cmdStatus
end tell

-- From: http://www.macosxhints.com/article.php?story=20011030193449870
-- Thanks!
on posix_path(mac_path)
    set mac_path to (mac_path as text)
    set root to (offset of ":" in mac_path)
    set rootdisk to (characters 1 thru (root - 1) of mac_path)
    tell application "Finder"
        if (disk (rootdisk as string) is the startup disk) then
            set unixpath to "/" & (characters (root + 1) thru end of mac_path)
        else
            set unixpath to "/Volumes:" & mac_path
        end if
    end tell
    set chars to every character of unixpath
    repeat with i from 2 to length of chars
        if item i of chars as text is equal to "/" then
            set item i of chars to ":"
        else if item i of chars as text is equal to ":" then
            set item i of chars to "/"
        else if item i of chars as text is equal to "'" then
            set item i of chars to "\\'"
        else if item i of chars as text is equal to "\"" then
            set item i of chars to "\\" & "\""
        else if item i of chars as text is equal to "*" then
            set item i of chars to "\\*"
        else if item i of chars as text is equal to "?" then
            set item i of chars to "\\?"
        else if item i of chars as text is equal to " " then
            set item i of chars to "\\ "
        else if item i of chars as text is equal to "\\" then
            set item i of chars to "\\\\"
        end if
    end repeat
    return every item of chars as string
end posix_path

Many users of Excel have made it common practice to color code cells to help identify inputs, formulas, etc. For example, it is common to color all cells act as hard coded inputs (i.e. not a formula) blue, all formulas black. This Excel macro looks at the contents of each selected cell and sets the color appropriately. Further I have added the green coloring for all external references.

' Set the color of cells to blue or black respectively
' Copyright under GPL by Mark Grimes
' Keyboard Shortcut: Crtl+Shift+C

Sub mgSetColor()
    For Each c In Selection.Cells
        If Left(c.Formula, 1) = "=" Then
            If InStr(c.Formula, ".xls") Or InStr(c.Formula, ".XLS") Then
                c.Font.ColorIndex = 10
            ElseIf InStr(c.Formula, "OFFSET") Then
                c.Font.ColorIndex = 9
            Else
                allNumbers = True
                For i = 1 To Len(c.Formula) - 1
                    If (Asc(Mid(c.Formula, i, 1)) < 40) Or (Asc(Mid(c.Formula, i, 1)) > 61) Then
                        ' MsgBox "Setting false: " & Mid(c.Formula, i, 0) & " = " & Asc(Mid(c.Formula, i, 1))
                        allNumbers = False
                        Exit For
                    Else
                        ' MsgBox Mid(c.Formula, i, 1) & " = " & Asc(Mid(c.Formula, i, 1))
                    End If
                Next
                If allNumbers Then
                    c.Font.ColorIndex = 5   ' blue
                Else
                    c.Font.ColorIndex = 0   ' auto
                End If
            End If
        Else
            c.Font.ColorIndex = 5
        End If
    Next
End Sub

When formatting a Excel sheet underlining or overlining (which appears as if you underlined the cell above) a cell often looks much better than just underlining the contents of the cell (ctrl-u). This macro will toggle the under/overlines for all the selected sells.

' Toggles Underlines
' [% coypright %]
' Keyboard Shortcur: Crtl+Shift+U
'
Sub mgSetUnderline()
    If Selection.Borders(xlBottom).LineStyle = xlNone Then
        With Selection.Borders(xlBottom)
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    Else
        Selection.Borders(xlBottom).LineStyle = xlNone
    End If
End Sub

' Toggles Overlines
' Copyright under GPL by Mark Grimes
' Keyboard Shortcur: Crtl+Shift+O
'
Sub mgSetAnOverline()
    If Selection.Borders(xlTop).LineStyle = xlNone Then
        With Selection.Borders(xlTop)
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    Else
        Selection.Borders(xlTop).LineStyle = xlNone
    End If
End Sub

I often want to have some space between row to call attention to a particular row, but rather than having a full row, a small row would work better. This macro will adjust the height of all the select cells if they are empty.

' Set the height of all blank selected rows to small
' Copyright under GPL by Mark Grimes
' Keyboard Shortcur: Crtl+Shift+E 
'
Sub mgShrinkSpaces()
    For Each c In Selection.Cells
        If c.Value = "" Then
            c.RowHeight = 5
        End If
    Next
End Sub

I hate merged cells. They create all sorts of problems adding/deleting columns, filling down, etc. But it can look nice to have text centered across a range not just a single cell. Luckily, Excel provides the rarely used Align Center formatting option. This macro provides easy access to toggling the alignment formatting across all selected cells... but that's not all... :-) it also centers the contents of a single cell if that is all that is selected.

' Toggles Align Center
' Copyright under GPL by Mark Grimes
' Keyboard Shortcur: Crtl+Shift+A
'
Sub mgCenterAlign()
    If Selection.count = 1 Then
        With Selection
            If .HorizontalAlignment = xlHAlignCenter Then
                .HorizontalAlignment = xlGeneral
            Else
                .HorizontalAlignment = xlHAlignCenter
            End If
        End With
    Else
        With Selection
            If .HorizontalAlignment = xlCenterAcrossSelection Then
                .HorizontalAlignment = xlGeneral
            Else
                .HorizontalAlignment = xlCenterAcrossSelection
            End If
        End With
    End If
End Sub

When I feel like getting fancy, it can be nice to include a bulleted list in an Excel sheet to describe assumptions, etc. This is actually pretty easy to do, but requires adding some odd characters. This macro will add a character and change the font of a cell to create a bullet. If you run this macro on a cell which already contains a bullet, an arrow shaped sub-bullet is inserted instead.

' Toggles a bullet and an arrow
' Copyright under GPL by Mark Grimes
' Keyboard Shortcut: Crtl+Shift+B
'
Sub mgBullet()
    If ActiveCell.Formula = "l" Then
        Selection.Font.Name = "Wingdings"
        ActiveCell.FormulaR1C1 = "bullet"
                ' Replace the text bullet with the bullet symbole from Wingdings
        ' Found that others don't have wingdings 3, it's sub-bullet was better
        ' Selection.Font.Name = "Wingdings 3"
        ' ActiveCell.FormulaR1C1 = "}"
    Else
        Selection.Font.Name = "Wingdings"
        ActiveCell.FormulaR1C1 = "l"
    End If
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = xlHorizontal
    End With
End Sub

This is one of my favorites. It saves a copy of the current file in the 'Backup' directory if one exists under the directory in which the file is currently saved. It saves the files with an incrementing two digit number after the filename (before the .xls extension). A cap of 50 backups is imposed just to keep from taking up too much disk space (my models tend to be BIG).

' Save a copy of the current file.
' Copyright under GPL by Mark Grimes
' Keyboard Shortcut: Crtl+Shift+S
'    Will save in the "Backup" subdirectory if it exists.
'    Will attempt to add an index number upto 50.
'
Sub mgSaveBackup()
    p0$ = ActiveWorkbook.Path
    If Dir(p0$ & "\Backup", vbDirectory) <> "" Then
        p$ = p0$ & "\Backup"
    End If
    
    n0$ = ActiveWorkbook.Name
    If Right(n0$, 4) <> ".xls" And Right(n0$, 4) <> ".XLS" Then
        MsgBox "File must be a previously saved '.xls' file."
        End
    End If
    n$ = Left(n0$, Len(n0$) - 4)
    
    i = 0
    Do
        i = i + 1
    Loop Until (Dir(p$ & "\" & n$ & "." & Application.Text(i, "00") & ".xls") = "") Or (i > 50)
    
    If i > 50 Then
        MsgBox "No more than 50 backup's can be made."
        End
    End If
    
    response = MsgBox("File to be backed-up as:" & Chr(10) _
            & p$ & "\" & n$ & "." & Application.Text(i, "00") & ".xls", vbOKCancel)
        
    If response = vbOK Then
        'FileCopy p0$ & "\" & n0$, p$ & "\" & n$ & "." & i & ".xls"
        ActiveWorkbook.SaveCopyAs p$ & "\" & n$ & "." & Application.Text(i, "00") & ".xls"
    Else
        MsgBox "Backup aborted!"
    End If
End Sub

I often like to have narrow empty columns between data columns just to make things look nice (cell underlining looks better that way in my opinion). This macro will prompt you for a number of columns per group and then it selects one column per group for the currently selected range (i.e. selecting A5:G5, running the macro and entering 2 would result in columns B, D, and F being selected). Then you can quickly resize those columns to make everything look real pretty.

'
' Select every other column
' Copyright under GPL by Mark Grimes
'
Sub mgSelectEOther()
    Dim i, mult As Integer
    Dim r, cst As String
    
    mult = Application.InputBox(prompt:="Select every x columns:", default:=2, Type:=1)
    
    r = ""
    i = 0
    For Each c In Selection
        i = i + 1
        If i Mod mult = 0 Then
            If (c.Column > 26) Then
                ' tx = c.Column & ": A=" & Asc("A") & ", " & Int(c.Column / 26) & ", " & (c.Column Mod 26)
                ' MsgBox tx
                cst = Chr(Asc("A") - 1 + Int(c.Column / 26)) & Chr(Asc("A") + (c.Column Mod 26) - 1)
            Else
                cst = Chr(Asc("A") + c.Column - 1)
            End If
            r = r & "," & cst & ":" & cst
        End If
    Next
    r = Right(r, Len(r) - 1)
    ' MsgBox r
    ActiveSheet.Range(r).Select
End Sub

This routine combines the selected cells into one long string in the current cell.

' Combine cells
' Copyright under GPL by Mark Grimes

Sub mgCombineCells()
    t = ""
    For Each c In Selection.Cells
        t = t & Trim(c.Formula) & " "
    Next
    t = Left(t, Len(t) - 1)
    ActiveCell.Formula = t
End Sub

Here are two routines that pull the formula from a note and put the formula in a note. I had a very specific need for this, but I can't recall why now.

' Creates a formula from the Note
' Copyright under GPL by Mark Grimes

Sub mgNote2Formula()
    For Each c In Selection.Cells
        c.Formula = c.NoteText
    Next
End Sub

'
' Put the formula in the note
' Copyright under GPL by Mark Grimes
Sub mgFormulaToNote()
    For Each c In Selection.Cells
        c.NoteText (c.Formula)
    Next
End Sub