I know…Wednesdays are supposed to be about reading, and they will be again, but this is the last week of NaNo so I’m a little focused, especially considering how behind I was. Yes, that’s right. Was. I’m not all caught up yet, but I went to sleep last night sitting on 43230, only around 1800 behind where I should be according to the 1667 words a day.

So, to celebrate, I thought I’d share something I cooked up when my brain decided I needed to shift gears and take a break.

The NaNo site suggests you mask your novel before validation, for your own peace of mind and to ensure no one tries to claim their novel was stolen. But switching all those letters around is annoying. I’ve been working in VB lately and it was on my mind, so I cooked up a macro to rewrite your novel for you into totally unreadable letters that retain the same word count. And who knows…you might find a couple crazy character names out of the deal.

The macro is below, but first, I wanted to share this link, the music of old style office machines. Amazingly, at one of the write-ins I went to recently, even laptops made a serious amount of sound with so many people typing furiously at the same time. The sound of productivity: http://www.theatlantic.com/technology/archive/2012/11/the-surprisingly-awesome-sound-of-156-office-machines-from-the-60s/265603/

To use this macro, you need to copy it into the VB page for your document. The easiest way is to record a new macro, select that macro and hit edit, then paste the macro text over it.

Sub Scramble()
'
' Scramble Macro
' Scramble letters for NaNo validation
' by Margaret Fisk
'
Dim mGet As Variant
Dim i As Integer, N As Integer, c As Integer
mGet = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
 "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"_
, "'") ' remove the last item (and its comma) to keep apostrophes.
N = UBound(mGet, 1)
    For i = 0 To N
        c = Int((N) * Rnd())
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = mGet(i)
            .Replacement.Text = mGet(c)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i
End Sub