Random word generator

[Gary Drumm]

Has anyone seen an Excel program that will generate words based on letters entered. For example, if I had 10 cells in a row, and each cell contained a letter (duplicates are okay), what words could be derived from arranging those letters in random sequences.

It would need the ability to accept any letter of the alphabet, A thru Z

E A L R C T S S U C
___ ___ ___ ___ ___ ___ ___ ___ ___ ___

How many words could it generate, and what are the words?
I assume it would have to reference a spelling dictionary.

It could be used as a spelling learning game, etc.

No rush, just curious if anyone has seen something like this.

Gary

[pgc01]

Hi Gary

It's easy to generate words based on a list of letters. You just have to build the permutations and check spell them. The problem is that, as you may remember, the factorial grows very fast, even faster than the exponential. This means that it's not a practical method for a big number of letters.

You can use the code I post comfortably with until 7 letters (about 8 seconds). For 8 letters it takes already one minute. For 10 letters it would take 1 and a half hours.

If you really want to build a tool to do this efficiently for any number of letters, you must take a different approach. One simple solution is to get the words of the dictionary and build a list of the words by theirs letter combinations (not permutations). This will be done just once and then finding the words with 3 letters or 15 will be the same, surely less than a second.

I used excel's spell checker in this code, writes the results in column A:

Sub PermValidWords()
Dim rRng As Range, lRow As Long, sStr As String

Set rRng = Range("C1:F1")

sStr = Join(Application.Index(rRng.Value, 1, 0), "")
lRow = 1
Columns("A").Clear
Call perm(sStr, "", lRow)
End Sub

Sub perm(sStr As String, sPerm As String, lRow As Long)

For i = 1 To Len(sStr)
    Call perm(Mid(sStr, 1, i - 1) & Mid(sStr, i + 1, Len(sStr) - i), sPerm & Mid(sStr, i, 1), lRow)
Next

If sStr = "" Then
    If lRow = 1 Or IsError(Application.Match(sPerm, Range("A1:A" & lRow), 0)) Then
        If Application.CheckSpelling(sPerm) Then
            Range("A" & lRow) = sPerm
            lRow = lRow + 1
        End If
    End If
End If
End Sub

Example:

*
A
B
C
D
E
F
G
1	opts	*	o	p	t	s	*
2	pots	*	*	*	*	*	*
3	post	*	*	*	*	*	*
4	tops	*	*	*	*	*	*
5	spot	*	*	*	*	*	*
6	stop	*	*	*	*	*	*
7	*	*	*	*	*	*	*
[Book1]Sheet2

Hope this helps
PGC

[mortgageman]

PGC - incredible code. I always love trying to figure out just how recursive code "does what it does". (I never really succeed however )

How would you add a message box that there were no words generated (like for a, b,c and d)? I tried but I couldn't see where to put the line without it showing up each time perm calls itself.

[pgc01]

Hi Gene

I also like recursive code, it's like you are just explaining the problem instead of divising an algorithm to solve it.

For example in this case the logic is just:

"To get the permutations of n letters pick up each one of the letters and have it followed by the permutations of the remaining (n-1) letters."


I would add a message box with the number of words generated at the end of the first Sub just before the End Sub.

MsgBox "There " & IIf(lRow = 2, "was ", "were ") & lRow - 1 & " word" & IIf(lRow = 2, "", "s") & " generated"

Kind regards
PGC

[mortgageman]

Worked perfectly, thanks much

[mortgageman]

PGC: When I put the letters l, i, d in the cells C1, D1, and E1 it generated the 1 word lid. However when I put the letters j,d,i,l in the cells C1,D1,E1 and F1 the program generated 0 words. Am I doing something wrong?

[mortgageman]

PGC: When I put the letters l, i, d in the cells C1, D1, and E1 it generated the 1 word lid. However when I put the letters j,d,i,l in the cells C1,D1,E1 and F1 the program generated 0 words. Am I doing something wrong?

Ok - I see why. The program (and I don't know if this is by design) only creates words in which ALL the letters are used - not just a subset.

[pgc01]

Gene

... and I don't know if this is by design ...

This is, in fact, by design. That's what I understood that the OP wanted.

However, it's interesting to consider all the words with all or some of the letters. In that case you can add an intermediate stage to deal with all the words made out of subsets of letters (minimum 2 letters).

I also sorted the result.

Sub PermValidWordsAll()
Dim rRng As Range, lRow As Long, sStr As String

Set rRng = Range("C1:G1")

sStr = Join(Application.Index(rRng.Value, 1, 0), "")
lRow = 1
Columns("A").Clear
Call PermAll(sStr, "", lRow)
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, MatchCase:=False
MsgBox "There " & IIf(lRow = 2, "was ", "were ") & lRow - 1 & " word" & IIf(lRow = 2, "", "s") & " generated"
End Sub

Sub PermAll(ByVal sStr As String, ByVal sPerm As String, lRow As Long)
Dim i As Integer

Call perm(sStr, sPerm, lRow)

If Len(sStr) > 2 Then
    For i = 1 To Len(sStr)
        Call PermAll(Mid(sStr, 1, i - 1) & Mid(sStr, i + 1, Len(sStr) - i), sPerm, lRow)
    Next
End If
End Sub


Sub perm(ByVal sStr As String, ByVal sPerm As String, lRow As Long)
Dim i As Integer

For i = 1 To Len(sStr)
    Call perm(Mid(sStr, 1, i - 1) & Mid(sStr, i + 1, Len(sStr) - i), sPerm & Mid(sStr, i, 1), lRow)
Next

If sStr = "" Then
    If lRow = 1 Or IsError(Application.Match(sPerm, Range("A1:A" & lRow), 0)) Then
        If Application.CheckSpelling(sPerm) Then
            Range("A" & lRow) = sPerm
            lRow = lRow + 1
        End If
    End If
End If
End Sub

As you see it's almost the same.

In this example you see that this code is only as good as the dictionary it uses. Microsoft acceps ht as a valid word. In fact it's not, it's an abbreviation of height. In my opinion it should not be accepted or, at least, we should have a parameter specifying if we want abbreviations.

I learned with this example that eth is an Icelandic letter, I had never seen this word before.

*
A
B
C
D
E
F
G
H
1	eh	*	s	h	e	e	t	*
2	et	*	*	*	*	*	*	*
3	eth	*	*	*	*	*	*	*
4	eths	*	*	*	*	*	*	*
5	he	*	*	*	*	*	*	*
6	hest	*	*	*	*	*	*	*
7	ht	*	*	*	*	*	*	*
8	se	*	*	*	*	*	*	*
9	see	*	*	*	*	*	*	*
10	set	*	*	*	*	*	*	*
11	she	*	*	*	*	*	*	*
12	sheet	*	*	*	*	*	*	*
13	tee	*	*	*	*	*	*	*
14	tees	*	*	*	*	*	*	*
15	the	*	*	*	*	*	*	*
16	thee	*	*	*	*	*	*	*
17	these	*	*	*	*	*	*	*
18	*	*	*	*	*	*	*	*
[Book1]Sheet2

Kind regards
PGC

[pgc01]

This new code brings together both options with a flag (bDown). With bDown=False it will only get words that use all the letters. With bDown=True it will not only get words that use all the letters but also words that use less letters down to 2.

It's also much more efficient than the previous code (equivalent to bDown=True), >50% gain in execution time.

Sub PermValidWordsAll()
Dim rRng As Range, lRow As Long, sStr As String, i As Integer, iStart As Integer, bDown

Set rRng = Range("C1:G1")
bDown = True   ' words with all or some of the letters

sStr = Join(Application.Index(rRng.Value, 1, 0), "")
lRow = 1
iStart = IIf(bDown, 2, Len(sStr))
Columns("A").Clear
For i = iStart To Len(sStr)
    Call perm(sStr, "", i, lRow)
Next i
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, MatchCase:=False
MsgBox "There " & IIf(lRow = 2, "was ", "were ") & lRow - 1 & " word" & IIf(lRow = 2, "", "s") & " generated"
End Sub

Sub perm(ByVal sStr As String, ByVal sPerm As String, ByVal iElem As Integer, lRow As Long)
Dim i As Integer

For i = 1 To Len(sStr)
    Call perm(Mid(sStr, 1, i - 1) & Mid(sStr, i + 1, Len(sStr) - i), sPerm & Mid(sStr, i, 1), iElem, lRow)
Next

If Len(sPerm) = iElem Then
    If lRow = 1 Or IsError(Application.Match(sPerm, Range("A1:A" & lRow), 0)) Then
        If Application.CheckSpelling(sPerm) Then
            Range("A" & lRow) = sPerm
            lRow = lRow + 1
        End If
    End If
End If
End Sub

Example:

*
A
B
C
D
E
F
G
H
1	ail	*	n	a	i	l	s	*
2	ails	*	*	*	*	*	*	*
3	al	*	*	*	*	*	*	*
4	an	*	*	*	*	*	*	*
5	anis	*	*	*	*	*	*	*
6	as	*	*	*	*	*	*	*
7	in	*	*	*	*	*	*	*
8	ins	*	*	*	*	*	*	*
9	is	*	*	*	*	*	*	*
10	la	*	*	*	*	*	*	*
11	lain	*	*	*	*	*	*	*
12	nail	*	*	*	*	*	*	*
13	nails	*	*	*	*	*	*	*
14	nil	*	*	*	*	*	*	*
15	ns	*	*	*	*	*	*	*
16	sail	*	*	*	*	*	*	*
17	san	*	*	*	*	*	*	*
18	sin	*	*	*	*	*	*	*
19	slain	*	*	*	*	*	*	*
20	snail	*	*	*	*	*	*	*
21	*	*	*	*	*	*	*	*
[Book1]Sheet2

PGC

[Gary Drumm]

This last post seems to be what I was looking for.

I'm thinking of it as a tool for children with learning disabilities.

Thank you very much

Gary