Correction, I meant a special thanks to Brian for the spellchecking tip!
Malcolm, I'm aware the code will run VERY slowly (if it works at all), but
hope that the result will be achievable while the game is being played.
Thanks again,
Terry.
"Terry Hornsby" <t.hornsby@lineone.net> wrote in message news:...
> 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.
>
> "Theo van der Ster" <mail@sterlingwaen.com> wrote in message
> news:ea60a533.0401032054.7158e5b7@posting.google.com...
> > Hi Terry,
> >
> > This is a better web page. It gives you the results immediately
> > instead of sending them thru the mail.
> >
> > Regards,
> > Theo van der Ster
> >
> > "Terry Hornsby" <t.hornsby@lineone.net> wrote in message
> news:<ujXuAfh0DHA.1532@TK2MSFTNGP10.phx.gbl>...
> > > Does anyone know how I can loop through a nine letter word & get all
the
> > > combinations of those nine letters (i.e., an anagram solver)?
> > >
> > > Many thanks,
> > >
> > > Terry
>
>