In this post we see how to create a free-form crossword puzzle in Excel using VBA macros. The program follows the same logic of the word search generator posted a few years back (see Word Search Generator). There is a later video about that on the YouTube channel too (link). But that was a simple and limited version though. A much better word search generator is available in this other page: Word Search Pro for Excel. But here we look into a slightly different approach that allows finding common letters to force words crossing and create the crossword in Excel.
Crossword Layout
There are several
types of crossword puzzles. We will create a free-form crossword in Excel. For
that, we need to format the row height and column width in the worksheet to
keep squared cells. Then we can hide the gridlines or apply any background
(interior) color. In this example, we have a row height of 14 and column width
of 2. The interior color for all cells in the worksheet is just transparent
(with hidden gridlines). We name the main worksheet “Crossword”. Another worksheet
stores the solution, and another one (or more) stores the words and
descriptions for a given theme.
With ActiveSheet.Cells
.RowHeight = 14
.ColumnWidth = 2
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False
End Sub
Add Word
The following routine
is used to add a word to the crossword in Excel. It adds each letter of the
word to each cell in the target range. We will see later how to determine the
target range, which is basically getting the position of the first letter and
fill down or right depending on the direction of the word added to the
crossword puzzle.
letter = Mid(word, n, 1)
If direc = 1 Then
With Cells(r, c + n - 1)
.Value = letter
.Borders.LineStyle = xlContinuous
End With
Else
With Cells(r + n - 1, c)
.Value = letter
.Borders.LineStyle = xlContinuous
End With
End If
Next n
The crossword
generator loops as many times as letters in the word (length of the word) and
gets each individual letter with the Mid function. This is the same principle used
to generate a word search puzzle in Excel (check this other post). If the word
is placed horizontally (direc=1), we increment the column each time (c + n -
1). The -1 is just because we start at n=1 (and need to start at column c, not
c+1). If the word is placed vertically (direc=2), we increment the row (r + n
-1). Then we add the letter and borders to the cell.
Before running the
code above, we need to check that all the cells are empty, except one. That’s
the cell with the letter in common between two words that are crossing (after
having placed the very first word). This other routine sets a range with the
length of the word starting in row r and column c spanning along a row to the
right (direc=1) or along a column down (direc=2). Download the file to see the
code here (this is a simplified version for demonstration purposes only).
Word Crossing
After placing the
first word, every other word needs to find a common letter with any of the
words added and be placed crossing that word if possible (if cells are empty in
that position). This is probably the most challenging part of the program. To
achieve that, we loop through each cell with content in the worksheet (or
rather in a given range, not the whole worksheet) to see if the next word has any
letters in common.
For Each cell In rng.SpecialCells(xlCellTypeConstants)
pos = InStr(word, cell.Value)
If pos > 0 Then 'there is a letter in common in that position
…
We get the direction
of the first word by checking a cell down the cell with common letter (using
Offset as below). Then we set the direction of the new word that will cross
either horizontally (direc=1) or vertically (direc=2).
If cell.Offset(1, 0) <> ""
Then direc = 1 Else direc = 2
Then we determine the starting row and column to place the new word based on the row and column of the cell with common letter (cell.Row and cell.Column) and the position of that letter in the new word (pos). Finally, we call the macro to add word that we have seen earlier.
c = cell.Column - pos + 1
r = cell.Row
Else
c = cell.Column 'new word crosses vertically
r = cell.Row - pos + 1
End If
Call AddWord(word, r, c, direc)
As we keep adding
words, we may want to keep a separation between them in order to achieve the
layout and arrangement of words of a free-form crossword (and not as a word
search). One way to do it is check that the four cells in diagonal positions
around the cell with the crossing letter are empty. We can achieve that in
Excel VBA with the property Offset. The following conditional statement checks
whether those four cells are empty to then move on with the rest of the code explained
above.
If cell.Offset(-1, -1).Value = "" And cell.Offset(-1, 1).Value = "" And _
cell.Offset(1, -1).Value = "" And cell.Offset(1, 1).Value = "" Then
'code above here
End If
This simple crossword
generator in Excel keeps adding words depending on the length and letters of
chosen words for a given theme. The longer the words, and the more letters in
common, the larger the crossword will grow.
However, the pattern
of the crossword is yet quite similar when running the macro. We should
randomize the process to pick words randomly rather than choosing from top to
bottom. We should also randomize the process that checks for words in common
and their position. As done here, it always picks the first cell with a common
letter and first letter in the next word, and therefore, the crossing is always
the same. We can easily change that too and add more randomness to the final
crossword puzzle. The full version of this crossword for Excel available in the
link below does that and adds words randomly too, but starts with longer words
so it may still create similar patterns sometimes. Furthermore, it does not
back-track and just keeps adding words as they come, so the outcome always different,
sometimes it adds a few words sometimes more. That can be improved by
implementing back-tracking to place words in a more efficient way that would
allow to pack more words into the crossword in Excel.
Check also Word Search Pro for Excel
Download Excel Crossword Generator
No comments:
Post a Comment