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.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
Private Sub Worksheet_Change(ByVal Target As Range) 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 :o)
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.
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)
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
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.
Thanks for sharing this! I took this and created a Google Spreadsheets version: https://docs.google.com/spreadsheets/d/1x39WCqjAIjjJkJ50tfPFORDUShqV1b2LAv92Detxoec/edit#gid=0
I couldn’t figure out a way to get the superscript and the regular letters to show up in the same cell, so I ended up using two separate cells adjacent to each other to constitute a single square. Would appreciate any feedback on it.
Tried the download but the numbering didn’t work correctly for me.
Also I wanted a 13×13 blank crossword to match the one in the local paper.
I have made another version here,13×13:
https://drive.google.com/file/d/1kX5IJCpsWYueqg2ZJxi5jO3jN8hZMO1h/view?usp=sharing
Also 15×15 here
https://drive.google.com/file/d/1XuS7HTY-DeICHjg4lIzGp6vyTbjMTRAU/view?usp=sharing
Feel free to try out, download and open in excel.
Add
Application.EnableEvents = True
immediately before “end sub”
in FixNumbers macro to allow entering more symmetrical black spaces after using FixNumbers macro.
I updated previous files so they now work (when I checked on excel2013)
I have made a 17×17 here;
https://drive.google.com/file/d/1R2–nB7ZSBiWp1USSEm-KjaQ16RblINZ/view?usp=sharing