An Excel VBA macro for cipher crosswords

I love solving cipher crossword puzzles, but I have always found the process of filling them out to be tedious. If I would discover, say, that the number “3” corresponds to letter “P”, then I would want all cells with the number to be filled with the corresponding letter automatically. And if I later change my mind and think that the number “3” corresponds to the letter “K” instead, then I want this change to be applied to all corresponding cells automatically. So, I devised an Excel VBA macro that would do all that.

The macro I devised only performs the tedious work of filling the cipher crossword; it does not help in any way in the solution. And this is exactly what I wanted to accomplish: I wanted to solve cipher crosswords by myself, but I wanted an automated way of filling the cells. I also wanted to experiment with each cipher crossword, because some are very difficult to solve, especially if you have no letter known in advance. (I have been able to solve cipher crosswords with no known letters in advance, even before I wrote the macro.)

The way my “scheme” operates is as follows: I reserve the first three lines of an Excel spreadsheet for the association of the numbers and the letters. I create a static table that contains the numbers from 1 to 26, one for each letter of the alphabet and beneath each number I reserve a cell for the corresponding letter, that I will enter once I find it. And the third line is to separate the table from the actual crossword.

Now, from the fourth line downwards, I enter the particular crossword’s data. In each cell in Excel, I enter the number the cell has inside it in the crossword. I made the macro handle up to 30 rows and 30 columns, but you can change that number if you find that you want to solve bigger cipher crosswords. There is no need to change those upper-bound numbers if your crosswords are smaller than that.

Of course, the tedious work of filling the cipher crossword has now been replaced by the tedious work of entering the number of every cell in the Excel grid. But this work is done up front and then you are able to enjoy solving the crossword undistracted. Not to mention that you might find someone who doesn’t mind helping you enter the crossword’s data in Excel.

The macro needs to be run after the crosswords data have been entered (from line four downwards). What the macro does is that it creates a “smart” reference to the corresponding cell in the table above. So, let suppose a cell that has the number “5”in it. After the macro is run, this cell will have an Excel formula that will do the following: The formula will first look in the table under the number “5” to see if there is a corresponding letter. If no corresponding letter has been entered, then the cell will continue to have the value “5”. If a corresponding letter has been entered in the table, then the cell will display this letter.

The macro’s code is the following:

Option Explicit

Sub Prepare_Cipher_Crossword()

   Dim myRowCounter As Integer
   Dim myColCounter As Integer
   Dim myCell As String

   Dim ExcelMajor As String
   Dim letterCounter As Integer
   Dim myExcelColumn As String

   Dim myRowRange As Integer
   Dim myColRange As Integer

   Dim myRowUpperBound As Integer
   Dim myColUpperBound As Integer

   myRowRange = 30      '30 rows
   myColRange = 30      '30 columns

   myRowUpperBound = myRowRange + 3    'From 4 to 33, there are 30 rows
   myColUpperBound = myColRange        'From 1 to 30, there are 30 columns

   For myRowCounter = 4 To myRowUpperBound        'From 4 to 33, there are 30 rows

      ExcelMajor = ""
      letterCounter = 0

      For myColCounter = 1 To myColUpperBound    'From 1 to 30, there are 30 columns

         If letterCounter = 26 Then
            letterCounter = 0
            If ExcelMajor = "" Then
                ExcelMajor = "A"
            Else
                ExcelMajor = Chr(Asc(ExcelMajor) + 1)
            End If
         End If

         myExcelColumn = ExcelMajor & Chr(letterCounter + Asc("A"))
         letterCounter = letterCounter + 1

         myCell = CStr(myExcelColumn & CStr(myRowCounter))

         Range(myCell).Select

         Select Case Trim(ActiveCell.FormulaR1C1)
            Case "1"
                ActiveCell.FormulaR1C1 = "=IF(R2C1="""",1,R2C1)"
            Case "2"
                ActiveCell.FormulaR1C1 = "=IF(R2C2="""",2,R2C2)"
            Case "3"
                ActiveCell.FormulaR1C1 = "=IF(R2C3="""",3,R2C3)"
            Case "4"
                ActiveCell.FormulaR1C1 = "=IF(R2C4="""",4,R2C4)"
            Case "5"
                ActiveCell.FormulaR1C1 = "=IF(R2C5="""",5,R2C5)"
            Case "6"
                ActiveCell.FormulaR1C1 = "=IF(R2C6="""",6,R2C6)"
            Case "7"
                ActiveCell.FormulaR1C1 = "=IF(R2C7="""",7,R2C7)"
            Case "8"
                ActiveCell.FormulaR1C1 = "=IF(R2C8="""",8,R2C8)"
            Case "9"
                ActiveCell.FormulaR1C1 = "=IF(R2C9="""",9,R2C9)"
            Case "10"
                ActiveCell.FormulaR1C1 = "=IF(R2C10="""",10,R2C10)"
            Case "11"
                ActiveCell.FormulaR1C1 = "=IF(R2C11="""",11,R2C11)"
            Case "12"
                ActiveCell.FormulaR1C1 = "=IF(R2C12="""",12,R2C12)"
            Case "13"
                ActiveCell.FormulaR1C1 = "=IF(R2C13="""",13,R2C13)"
            Case "14"
                ActiveCell.FormulaR1C1 = "=IF(R2C14="""",14,R2C14)"
            Case "15"
                ActiveCell.FormulaR1C1 = "=IF(R2C15="""",15,R2C15)"
            Case "16"
                ActiveCell.FormulaR1C1 = "=IF(R2C16="""",16,R2C16)"
            Case "17"
                ActiveCell.FormulaR1C1 = "=IF(R2C17="""",17,R2C17)"
            Case "18"
                ActiveCell.FormulaR1C1 = "=IF(R2C18="""",18,R2C18)"
            Case "19"
                ActiveCell.FormulaR1C1 = "=IF(R2C19="""",19,R2C19)"
            Case "20"
                ActiveCell.FormulaR1C1 = "=IF(R2C20="""",20,R2C20)"
            Case "21"
                ActiveCell.FormulaR1C1 = "=IF(R2C21="""",21,R2C21)"
            Case "22"
                ActiveCell.FormulaR1C1 = "=IF(R2C22="""",22,R2C22)"
            Case "23"
                ActiveCell.FormulaR1C1 = "=IF(R2C23="""",23,R2C23)"
            Case "24"
                ActiveCell.FormulaR1C1 = "=IF(R2C24="""",24,R2C24)"
            Case "25"
                ActiveCell.FormulaR1C1 = "=IF(R2C25="""",25,R2C25)"
            Case "26"
                ActiveCell.FormulaR1C1 = "=IF(R2C26="""",26,R2C26)"
         End Select

      Next myColCounter

   Next myRowCounter

   Range("A4").Select
End Sub

In the following screenshot, I show the Excel sheet after the crossword’s data have been entered, but the macro has not been run yet. The crossword here is only one line long, but I think it will get the point across (pun intended?).