Crossword Template

Do you like to spend your free time writing and editing crossword puzzles? Who doesn’t. Well, hopefully this crossword template will make it easier.

It starts with this blank puzzle.

You enter a space to indicate a black cell and the opposite cell also becomes black.

When you’re done entering spaces, you get a perfectly symmetrical puzzle with all the numbers in the right places.

Let’s see how it’s done. The puzzle starts in C3. Cell C3 has a ‘1’ in it. C4:C17 have this formula

=MAX(C3:Q3)+1

It figures out the largest number in the above row and adds one. D3:Q17 have this formula

=IF(OR(C3=” “,D2=” “),MAX(MAX($C$3:C3),MAX($C$2:Q2))+1,”")

If the space above or the left has a space, it figures the largest number above and to the left and adds one. In order for that one to work properly, C2:Q2 and B3:B17 contain spaces.

All of the cells in the grid have this conditional formatting.

Finally, a Worksheet_Change event restores deleted cells and blacks out symmetrical cells.

I named the cell in the middle of the puzzle ‘rngMiddle’ so I could get the proper offsets.

A while back, I saw an episode of Independent Lens called Wordplay. It showed how crossword writers write, and it’s nothing like this template works. They fill in the letters first, then black out where they need to. Putting superscript numbers and regular letters in the grid was too hard for a Monday night, so it will have to wait for version 2.

You can download crossword.zip

25 thoughts on “Crossword Template

  1. “Do you like to spend your free time writing and editing crossword puzzles? Who doesn’t.”
    That really made my morning! I think that I just might start writing and editing my own thanks to you.

  2. You can use a single formula (copied down and across) like this if the cells above the first row and to left of first column contain spaces:

    =IF(OR(B3=” “,C2=” “),COUNT($B3:B3)+COUNT($C$2:$Q2)+1,””)

    Assuming you continue to have a named range rngMiddle in the exact center of the crossword, then the new formula allows the Worksheet_Change sub to be simplified to:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rCell As Range, rngMiddle As Range, targ As Range
    Set targ = Range(“C3:Q17”)  ‘Watch these cells only. Cells to left and top must contain space characters. Only works on one area.
    Set targ = Intersect(targ, Target)

    Application.EnableEvents = False
    Set rngMiddle = Me.Range(“rngMiddle”)
        For Each rCell In targ.Cells
            If rCell.Value = “” Then rCell.FormulaR1C1 = _
                “=IF(OR(RC[-1]=”” ““,R[-1]C=”” ““),COUNT(RC2:RC[-1])+COUNT(R2C3:R[-1]C17)+1,”“”“)”
            rngMiddle.Offset(-(rCell.Row – rngMiddle.Row), -(rCell.Column – rngMiddle.Column)).FormulaR1C1 = rCell.FormulaR1C1
        Next rCell
    Application.EnableEvents = True
    End Sub

  3. Code modifications to allow for entering letters into boxes. Included code to concatenate the letter entered with the number present before the letter was added (or subsequently after the contents were deleted), along with in-cell formatting to make the number look the same.

    Added to the cell formula to look at only the number part of a cell with a letter entered.

    There seems to be a quirk whenever “A” or “P” are keyed in a cell. When VBA executes:

    rcell.value=b & ” ” & a

    the value returned to the cell is either ~.29 or ~.79. Any thoughts on why this happens??

            If Not (IsEmpty(rCell.Value)) Then
                If rCell.Value <> ” “ Then
                    a = rCell.Value
                    If rCell.Column > 3 And rCell.Column < 18 Then
                        rCell.FormulaR1C1 = “=IF(OR(RC[-1]=”” ““,R[-1]C=”” ““),” & _
                            “IF(and(ISERROR(RC[-1]*1),rc[-1]<>”” ““,rc[-1]<>”“”“),LEFT(rc[-1],2)+1,” & _
                            “MAX(MAX(R3C3:RC[-1]),MAX(R2C3:R[-1]C17))+1),”“”“)”
                    ElseIf rCell.Column = 3 And rCell.Row > 3 Then
                        rCell.FormulaR1C1 = “=MAX(R[-1]C:R[-1]C[14])+1”
                    ElseIf rCell.Address = “$C$3” Then
                        rCell.Value = 1
                    End If
                    b = rCell.Value
                    If b = “” Then
                        b = ”  “
                    End If
                    rCell.Value = b & ”  “ & a
                    With rCell.Font
                        .Size = 14
                        .Superscript = True
                    End With
                    With rCell.Characters(Start:=3, Length:=3).Font
                        .Size = 16
                        .Subscript = True
                    End With
                End If
            End If
           
            ‘if the cell is deleted, put the formula back in the cell
          If IsEmpty(rCell.Value) Then
                If rCell.Column > 3 And rCell.Column < 18 Then
                    rCell.FormulaR1C1 = “=IF(OR(RC[-1]=”” ““,R[-1]C=”” ““),” & _
                            “IF(and(ISERROR(RC[-1]*1),rc[-1]<>”” ““,rc[-1]<>”“”“),LEFT(rc[-1],2)+1,” & _
                            “MAX(MAX(R3C3:RC[-1]),MAX(R2C3:R[-1]C17))+1),”“”“)”
                ElseIf rCell.Column = 3 And rCell.Row > 3 Then
                    rCell.FormulaR1C1 = “=MAX(R[-1]C:R[-1]C[14])+1”
                ElseIf rCell.Address = “$C$3” Then
                    rCell.Value = 1
                End If
            End If
  4. […] starts with this blank puzzle. You enter a space to indicate a black cell and the opposite cell… [full post] Dick Kusleika Daily Dose of Excel eventsformattinggames 0 0 0 […]

  5. Dick: Do you know of any way to bypass that? I’m not sure of many instances other than this that it may be necessary, but I’m more curious than anything.

  6. @Doug Glancy

    <>

    That reminds me of an article I once read where a guy who composed crosswords for the Times said that he liked to catch the train to London and effortlessly complete the Times crossword. The other passengers looked on in awe

  7. Hi Dick very nice job, especially the event that restores deleted cells :) I don’t know yet where I can use it but I am sure it will be very useful another day.
    Marry Christmas btw :)

  8. Hi
    I am not an Excel buff, just a basic user. I am interested in crossword compiling and came across your template. Thank you, it’s great.
    The automatic blacking out of symmetrical squares is not working for me though. Any ideas?

    Thanks Angela

  9. Angela: It’s likely that you don’t have macros enabled. In 2003 and earlier, go to Tools – Macros – Security and change the setting from High to Medium. Now open this workbook and it should ask you if you want to enable or disable macros. Enable them and it should work.

  10. Yes, thank you. That ws it. I thought I had aleady enabled macros but apparently not.
    We now have 2007 and I am not yet accustomed to it as much as 2003 – not that I’m great at that :o)

    Am enjoying using the template thank you.
    Angela

  11. Thanks for this. Had been hunting everywhere for anything like it. I could not get it going for a while, being a novice with Excel, but a great light shone suddenly & I realised what I was doing wrong! Will be using this for crosswords in a seniors computer club newsletter.
    Is there a way to vary the grid size, eg. 11, 13 cells each way?
    God bless people who share their knowledge and inventiveness.

  12. Problem of single letter words (+ solution) –

    I love this idea and am enjoying playing with it. There is a problem when more black squares are added that the crossword numbers as if single letter words are accepted.
    I.e. If you put a space in D3 and D4 the cell C4 is numbered as if it is the start of a word across (it can’t be the start of a word down as cell C3 is the start of the word down).
    I worked on the formula in D4 to fix this changing IF(OR(C4=” “, D3=” “) to IF(OR( And(C4=” “, E4” “), And(D3=” “, D5” “)). The problem with this is that it creates a circular reference which Excel complains about.
    There is a solution to this by turning on iteration (In Excel 2010 : File -> Options -> Formulas -> select Enable Iterative Calulation. Also set Max Iterations to 1).

    Before this solution works fully there are a few other small changes needed – The Cell D4 was changed from
    =IF(OR(C4=” “,D3=” “),MAX(MAX($C$3:C4),MAX($C$2:Q3))+1,””)
    to
    =IF(OR(AND(C4=” “,E4” “),AND(D3=” “,D5” “)),MAX(MAX($B$3:C4),MAX($C$2:R3))+1,””)

    (The ranges needed extending so the next step, to fill the cells round the edge with the same formula, would work)

    Now fill from this cell to all cells in the grid EXCEPT the first (C3) and last (Q17)

  13. Update to previous – This submission form removed “greater than” and “less than” symbols so the above formulas reading E4″ “, for example, should read E4’greater than”less than'” ” – can’t think of a better way of putting this

  14. Great tool thanks – I do a monthly crossword for a local paper, and occasional guest puzzles – this has saved me heas of time :)
    Tip for anyone PDF’ing the content by copy/pasting from excel (many local papers etc request this format) – slide the zoom slider (extreme bottom right in excel) to 200%, then get the grid and the font looking right onscreen. The printer can then scale down the resulting PDF to get a decent DPI (resolution). There are other ways to achieve the same thing, but that is the simplest.

  15. Add
    Application.EnableEvents = True
    immediately before “end sub”
    in FixNumbers macro to allow entering more symmetrical black spaces after using FixNumbers macro.


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.