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
It figures out the largest number in the above row and adds one. D3:Q17 have this formula
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.
Dim sFormula As String
Dim lRow As Long, lCol As Long
Dim rCell As Range
Application.EnableEvents = False
For Each rCell In Target.Cells
‘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=”” ““),MAX(MAX(R3C3:RC[-1]),MAX(R2C3:R[-1]C[13]))+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
‘If a cell is blacked out, find its symmetrical brother and enter a space
If rCell.Value = Space(1) Then
lRow = -(rCell.Row – Me.Range(“rngMiddle”).Row)
lCol = -(rCell.Column – Me.Range(“rngMiddle”).Column)
Me.Range(“rngMiddle”).Offset(lRow, lCol).Value = Space(1)
End If
Next rCell
Application.EnableEvents = True
End Sub
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
“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.
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:
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:
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
And, coincidentally this morning, in one of my RSS feeds was the link, http://www.wikihow.com/Become-a-Cruciverbalist. Fate must be trying to tell me something. (9 Down, 10 letters?)
Wordplay is an excellent movie. One amazing scene is the guy doing the whole NY Times Sunday crossword in two minutes.
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:
the value returned to the cell is either ~.29 or ~.79. Any thoughts on why this happens??
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
Bryan: Excel thinks you want time (AM/PM) when you enter an A or P after a number.
[...] 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 [...]
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.
@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
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
Byran: Precede the entry with a ‘ (single apostrophe). I’m revamping my code based on the comments, so you’ll see how I did it.
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
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.
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
Am enjoying using the template thank you.
Angela
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.