Thanks for all the suggestions, particularly Malcolm for the preferred
spelling error check in Word. I had simply used checkspelling.
I have seen the stand-alone programs & the server-based anagram makers (some
of them are gobsmackingly amazing), but I was wanting code for vba because I
have a created an Excel-based game that will see use at family
get-togethers.
I can see no way around a for each & do loop structure (by combining the two
forms of the loop I think I can reduce the lines of looping code down to 12,
excluding the lines which deal with the actual string. Something like: -
Set RngCube = Range("E2:G4")
For Each RngCell In RngCube
StrResult = StrResult & RngCell
Next RngCell
IntTote = 6
IntA=9
do while IntA >=4
for Int1 = 1 to IntA
''''''Pass string (using a mid statement) to the
spellchecker
'''''something like (the following DOES need amending!
StrTmp = Right(StrResult, Len(StrResult) - IntA) &
Left(StrResult, IntA)
If Application.CheckSpelling(StrTmp) = True Then
Range("A" & IntTote) = StrTmp
IntTote = IntTote + 1
End If
IntB=IntA-1
if inta<=8 then
do while IntB >=1
for Int2 = 1 to IntB
''''''Pass string (using a mid statement) to the
spellchecker, taking IntB as the mid character position
'''''something like (the following DOES need amending!
StrTmp = Right(StrResult, Len(StrResult) - IntB) &
Left(StrResult, IntB)
If Application.CheckSpelling(StrTmp) = True Then
Range("A" & IntTote) = StrTmp
IntTote = IntTote + 1
End If
Next Int2
Int2=Int2-1 ''replace one character with another from
the remaining 8 characters
Loop
End if
Next Int1
IntA=IntA-1 ''remove one character from the original 9 one at a
time until only 4 remain
Loop
'''This bit creates my random 9 letters (which I alter to ensure
3 letters are vowels)
Sub RndmLtrGenrtr()
Dim RngCube As Range, RngCell As Range, IntArr As Integer, IntTote As
Integer, _
IntCount As Integer, StrResult As String, VarVwls As Variant, BoolFound As
Boolean
VarVwls = Array("A", "E", "I", "O", "U", "Y")
Set RngCube = Range("E2:G4")
RngCube.ClearContents
For Each RngCell In RngCube
StrResult = Chr(Int((90 - 65 + 1) * Rnd + 65))
RngCell = StrResult
Next RngCell
For Each RngCell In RngCube
For IntArr = 0 To 5
If RngCell = VarVwls(IntArr) Then
IntTote = IntTote + 1
End If
Next IntArr
Next RngCell
IntCount = 3 - IntTote
If IntCount > 0 Then
For IntTote = 1 To IntCount
For Each RngCell In RngCube
BoolFound = False
For IntArr = 0 To 5
If RngCell = VarVwls(IntArr) Then
BoolFound = True
Exit For
End If
Next IntArr
If BoolFound = False Then
StrResult = VarVwls(Int((6 - 1 + 1) * Rnd + 1) - 1)
RngCell = StrResult
Exit For
End If
Next RngCell
Next IntTote
End If
End Sub
Thanks to all once again,
Terry.
