Algorithm to generate words

[akhileshbc]

Can you show me an effective algorithm to create all possible words(of any combination) from some characters inputted?

Eg:
Input: a,b,c

Output:
abc
acb
bac
bca
cab
cba

[Arispan]

Hello,

You can use this function:

Public Function GenerateStr()
strInputString = txtInput.Text ' Change this textbox with your own
intLength = Len(strInputString)
intNameLength = Len(txtInput.Text)
strName = ""
For intStep = 1 To intNameLength
intRnd = Int((intLength * Rnd) + 1)
strName = strName & Mid$(strInputString, intRnd, 1)
Next
GenerateStr = strName
End Function

And then do something like this:

Private Sub Command1_Click()
txtOutput.Text = GenerateStr ' Change this textbox with your own "output textbox"
End Sub

This will work

EDIT: You can add this function inside module if you want.

[LaVolpe]

For additional information or maybe other solutions, search the forum for: permutation.
The greater the source string, the greater the time required to return the permutations.

[akhileshbc]

Thanks guys...

I found this upon searching: http://www.vbforums.com/showpost.php...5&postcount=17

I have some doubts.
* What is the use of that Optional X string ?

[Spoo]

Akhil

Here is my stab at your puzzle .. and quite the puzzle it is

The image (below) shows 2 cases:
- abc
- abcd

The code has 2 basic components
- permutation logic
- FlexGrid logic (for display purposes)

Hopefully, the display logic isn't too messy.

The approach I used was to use
- 2 nested loops (common to both cases)
- multiple "passes" (some commonality, but some differences in each case)

The lack of commonality between the multiple "passes"
means that as you go to
- 5 characters, an 4th pass would be needed
- 6 characters, a 5th pass would be needed.

Not as "generic" as I would have liked, but at least
this might serve as a starting point for you.

All you need is a MSHFlexGrid named FG1.

Note: I put most of the FG1 properties at the bottom of
the code frag, for clarity. You may want to move them
to the top as you play around with it.

EDIT:

Now that I think about it, the logic as shown only works for
the characters a,b,c,d. Even though I facilitate you setting
the initial txt variable, the loops are hard-wired to start
at Chr(97), which is "a".

To make the code frag react to a different string, say, txt = "hot",
some additional logic would need to be added.

        With FG1
            .Cols = 7
            .Rows = 26
            .Clear
            ' demonstrate for 2 cases: abc, abcd
            For jj = 1 To 2
                '----------------------
                ' 1. computation
                '----------------------
                If jj = 1 Then                  ' abc
                    txt = "abc"
                ElseIf jj = 2 Then              ' abcd
                    txt = "abcd"
                End If
                nn = Len(txt)
                ' num of permutations - common
                nop = 1
                For kk = nn To 1 Step -1
                    nop = nop * kk
                Next kk
                Dim aP() As String
                ReDim aP(nop)
                ' the permutations - specific
                '.......................................................
                ' 1.1. abc  3x2 = 6
                '.......................................................
                If jj = 1 Then
                    ' pass-1 - 1st 2 chars
                    nn = 0
                    For aa = 1 To 3             ' 3
                        For bb = 1 To 3         ' 2
                            If bb <> aa Then
                                nn = nn + 1
                                aP(nn) = aP(nn) + Chr(96 + aa) + Chr(96 + bb)
                            End If
                        Next bb
                    Next aa
                    ' display pass1
                    For kk = 1 To nop
                        .TextMatrix(kk + 1, (jj - 1) * 3 + 1) = aP(kk)
                    Next kk
                    ' pass-2 - 3rd (last) char
                    For nn = 1 To nop
                        For bb = 1 To 3         ' 2
                            tst = Chr(96 + bb)
                            v1 = InStr(aP(nn), tst)
                            If v1 = 0 Then
                                aP(nn) = aP(nn) + Chr(96 + bb)
                            End If
                        Next bb
                    Next nn
                '.......................................................
                ' 1.2. abcd 4x3x2 = 24
                '.......................................................
                ElseIf jj = 2 Then
                    ' pass-1 - 1st 2 chars
                    nn = 0
                    For aa = 1 To 4             ' 4
                        For bb = 1 To 4         ' 3
                            If bb <> aa Then
                                nn = nn + 1
                                aP(nn) = aP(nn) + Chr(96 + aa) + Chr(96 + bb)
                                ' do twice
                                nn = nn + 1
                                aP(nn) = aP(nn) + Chr(96 + aa) + Chr(96 + bb)
                            End If
                        Next bb
                    Next aa
                    ' display pass1
                    For kk = 1 To nop
                        .TextMatrix(kk + 1, (jj - 1) * 3 + 1) = aP(kk)
                    Next kk
                    ' pass-2 - 3rd char
                    For nn = 1 To nop
                        For bb = 1 To 4         ' 2
                            tst = Chr(96 + bb)
                            v1 = InStr(aP(nn), tst)
                            If v1 = 0 Then
                                ' chk if this already exists
                                chk = aP(nn) + Chr(96 + bb)
                                hv = 0
                                For mm = 1 To nn
                                    If chk = aP(mm) Then  ' it exists
                                        hv = 1
                                        Exit For
                                    End If
                                Next mm
                                If hv = 0 Then
                                    aP(nn) = aP(nn) + Chr(96 + bb)
                                    Exit For
                                End If
                            End If
                        Next bb
                    Next nn
                    ' display pass1
                    For kk = 1 To nop
                        .TextMatrix(kk + 1, (jj - 1) * 3 + 2) = aP(kk)
                    Next kk
                    ' pass-3 - 4th (last) char
                    For nn = 1 To nop
                        For bb = 1 To 4         ' 2
                            tst = Chr(96 + bb)
                            v1 = InStr(aP(nn), tst)
                            If v1 = 0 Then
                                aP(nn) = aP(nn) + Chr(96 + bb)
                            End If
                        Next bb
                    Next nn
                End If
                '----------------------
                ' 2. display
                '----------------------
                ' caption - original
                .Row = 0
                .Col = (jj - 1) * 3 + 1
                .CellBackColor = RGB(200, 255, 255)
                .Text = txt
                .CellAlignment = 3
                '
                .Col = (jj - 1) * 3 + 2
                .CellBackColor = RGB(200, 255, 255)
                .Text = txt
                .CellAlignment = 3
                If jj = 2 Then
                    .Col = (jj - 1) * 3 + 3
                    .CellBackColor = RGB(200, 255, 255)
                    .Text = txt
                    .CellAlignment = 3
                End If
                ' pass number
                .Row = 1
                .Col = (jj - 1) * 3 + 1
                .CellBackColor = RGB(200, 255, 255)
                .Text = "pass1"
                .Col = (jj - 1) * 3 + 2
                .CellBackColor = RGB(200, 255, 255)
                .Text = "pass2"
                If jj = 2 Then
                    .Col = (jj - 1) * 3 + 3
                    .CellBackColor = RGB(200, 255, 255)
                    .Text = "pass3"
                End If
                ' data
                oo = jj + 1
                For kk = 1 To nop
                    .TextMatrix(kk + 1, (jj - 1) * 3) = kk          ' row number
                    .Row = kk + 1
                    .Col = (jj - 1) * 3
                    .CellBackColor = RGB(200, 255, 255)
                    .TextMatrix(kk + 1, (jj - 1) * 3 + oo) = aP(kk) ' final data
                Next kk
            Next jj
            .Top = 4200
            .Left = 14000
            .Height = 5000
            .Visible = True
            .Height = .Rows * 240
            .ColWidth(0) = 300
            .ColWidth(1) = 600
            .ColWidth(2) = 600
            .ColWidth(3) = 300
            .ColWidth(4) = 600
            .ColWidth(5) = 600
            .ColWidth(6) = 600
            .Width = 3600
            .MergeCells = flexMergeFree '  = flexMergeRestrictColumns
            .MergeRow(0) = True
        End With

Spoo

.

[akhileshbc]

Thanks Spoo...

Thanks for the effort. I will try reading it line by line to understand the logic behind it...

[Spoo]

Akhil

10-4.
Holler if you have any questions

Spoo

[akhileshbc]

Akhil

10-4.
Holler if you have any questions

Spoo

Thanks Spoo...

It takes some time for me to completely understand your code. If I have doubts, I will surely ask you...

[Zach_VB6]

Akhil: check this out http://en.wikipedia.org/wiki/Permuta...e_permutations

[akhileshbc]

Akhil: check this out http://en.wikipedia.org/wiki/Permuta...e_permutations

Thanks Zach...

[Spoo]

Akhil

I realize that it can be a pain to try to reverse-engineer
someone else's logic, so here's a little crib sheet to help
you out.

Let's first just consider jj = 1 (for the "abc" condition)

1. txt = "abc"
2. nn = Len(txt) = 3
3. nop loop will iterate to 1*3*2*1 = 6 (number of permutations)
4. Dim, ReDim aP() -- will be a 1-D array to hold the results
5. pass-1 (1st 2 chars) nested loops
-- each loop goes from 1 to 3 (where 3 is hardwired, but is really just nn)
-- test bb <> aa is to prevent repeated letters
6. display results of pass-1
7. pass-2 (last char) -- loop thru all results so far, and add the missing letter

Now, let's consider jj = 2 (for the "abcd" condition)

1. txt = "abcd"
2. nn = Len(txt) = 4
3. nop loop will iterate to 1*4*3*2*1 = 24 (number of permutations)
4. Dim, ReDim aP() -- will be a 1-D array to hold the results
5. pass-1 (1st 2 chars) nested loops
-- each loop goes from 1 to 4 (where 4 is hardwired, but is still just nn)
-- test bb <> aa is to prevent repeated letters
-- do twice -- I cheated here. This wasn't needed for jj=1. But "generically"
the "need" here seems to be governed by the 3rd number in the permutation,
ie, the 2 in 4x3x2x1
6. display results of pass-1
7. pass-2 (3rd char)
-- outer loop is all 24
-- inner loop is nn (ie,4)
-- introduces new concept - the InStr() test
8. display results of pass-2
9. pass-3 (last char) -- loop thru all results so far, and add the missing letter.
This is the same as the final pass for the other case

I adopted mostly a trial and error process to achieve the
results (hence the utility of displaying results at end of each pass).

But again, while there isn't full compatability between the two cases,
some sort of pattern seems to be emerging.
-- I was able to keep the number of loops constant (2, an outer and inner)
-- I was not able to devise a generic way to handle the number of passes

Hope this helps.

Spoo

[Spoo]

Akhil: check this out http://en.wikipedia.org/wiki/Permuta...e_permutations

Zach

D'oh! Great thought.
I did a preliminary Forum search (not much help), but didn't think
of Wiki.

Akhil

The Wiki section "systematic generation of all permutations" seems to
be the answer. Now, can you turn that brief discussion into code?
I expect a report

Spoo

[akhileshbc]

Hi guys..

I've worked on another part of this game. That is, user will input a word which has some missing characters. So, it's the job for the computer to generate all combinations of words by filling the missing characters with some alphabets.

I've programmed it in this way. You need to have a CommandButton and ListBox for trying this code.
Each line has comments, describing it's usage. So, I think you'll be able to get my idea by reading those comments.

Option Explicit

Dim strTempWords()  As String   '~~~ This will hold the Temporary words
Dim lngTempCount    As Long     '~~~ Counter

Private Sub Command1_Click()    '~~~ On clicking the button
    Dim strInput    As String
    Dim i           As Long
    Dim j           As Long
    Dim lngMissing  As Long
    
    strInput = "*s*om*" '~~~ Input string that has missing characters (marked in "*")
    
    lngTempCount = -1   '~~~ Initial value
    
    '~~~ We are inserting the string strInput into the array
    lngTempCount = lngTempCount + 1
    ReDim Preserve strTempWords(lngTempCount)
    strTempWords(lngTempCount) = strInput
    
    lngMissing = 1  '~~~ This will holds the number of words that has missing characters in the strTempWords array
    i = 0
    
    Dim strTemp     As String
    Dim strTemp2    As String
    
    While lngMissing > 0    '~~~ Loops until there's no word with missing characters
        strTemp = strTempWords(i)   '~~~ Copies an element from the array
        strTempWords(i) = ""        '~~~ That corresponding element in the array is emptied. (I think, it is better to shift the array here)
        lngMissing = lngMissing - 1 '~~~ We have selected a word that contains the missing words from the array. So, we will decrement it's count
        For j = 97 To 122           '~~~ a to z
            strTemp2 = Replace(strTemp, "*", Chr$(j), , 1)  '~~~ We will replace the first occurence of the '*' with the character
            
            If InStr(1, strTemp2, "*") > 0 Then lngMissing = lngMissing + 1 '~~~ Check if this new word contains atleast a single missing character. ie. '*'. If so, increment the lngMissing counter

            '~~~ We are adding this new word to our strTempWords array
            lngTempCount = lngTempCount + 1
            ReDim Preserve strTempWords(lngTempCount)
            strTempWords(lngTempCount) = strTemp2
        Next
        If lngMissing > 0 Then i = i + 1    '~~~ If there's a word that contains missing character, we will increment it. (We are moving to the next element in the array, during the next iteration of the While..Wend loop)
    Wend
    
    '~~~ Displays the final words in a Listbox
    For i = LBound(strTempWords) To UBound(strTempWords)
        If Len(strTempWords(i)) > 0 Then List1.AddItem strTempWords(i)  '~~~ The words in the strTempArray that contains non-empty string is added to the ListBox
    Next
    
    '~~~ Displays the size of the array. It is very large here. I think, array shifting needs to be done !
    MsgBox "Array size: " & UBound(strTempWords) & vbCrLf & "Word count in Listbox: " & List1.ListCount
End Sub

When the user's input is: *s*om* , the array size (dynamic array) is about 18278 and the total words generated is about 17576.

Guys, do you think my code is not efficient ? Or, is there anything that I can do it to improve ?

One thing I noticed is the array size. I'm using a dynamic array for the entire process.
That is, all words will be inserted into the same array. I think, there's a need of array shifting !
What's your opinion, guys ?

Any ideas ???

[Milk]

@akhil, sorry this has nothing to do with your last post. Its a version of the algorithm mentioned in Wikipedia. It uses a little bit a array hacking to have a string which is also an Integer array.

  Dim x As cPermutations
  Set x = New cPermutations

  x.Text = "banana"
  
  Do While x.PermutationsLeft
    Debug.Print Join(x.NextNPermutations(7), ", ")
  Loop

Results in...

aaabnn, aaanbn, aaannb, aabann, aabnan, aabnna, aanabn
aananb, aanban, aanbna, aannab, aannba, abaann, abanan
abanna, abnaan, abnana, abnnaa, anaabn, anaanb, anaban
anabna, ananab, ananba, anbaan, anbana, anbnaa, annaab
annaba, annbaa, baaann, baanan, baanna, banaan, banana
bannaa, bnaaan, bnaana, bnanaa, bnnaaa, naaabn, naaanb
naaban, naabna, naanab, naanba, nabaan, nabana, nabnaa
nanaab, nanaba, nanbaa, nbaaan, nbaana, nbanaa, nbnaaa
nnaaab, nnaaba, nnabaa, nnbaaa

[akhileshbc]

Thanks Milk...

[akhileshbc]

Once again, thanks to all those posters in this thread...

Another question regarding to all those posts(except post#13):

What will be the best way to check if it's an actual word in English. I mean, upon generating the words, I would check the words with a list of words in textfile (which are valid words in English), to find whether it exists in English language.

Do you have any tweaks or ideas to make it faster ?
Currently, I will grab all the words into an array on apllication startup. And then, loop through those arrays to find a matching word.

I think instead of looping through the arrays, can't we Join the array to a single string, and then check the existence of the word using Instr() in the string variable ?

Guys, what do you think ? Any ideas ?

[anhn]

This is my own way to use recursive to build an array of words from a given number of characters.
It is a short and simple function.

@Merri/Milk, perhaps you can optimize it. On my laptop, with 9 characters input, it generates 362,880words in 2.7 seconds in Excel VBA.

Option Explicit

Sub BuildWords(Chars As String, Words() As String, Optional bPredim As Boolean)
    '-- bPredim for internal use only
    '-- Chars should not have more than 10 characters (max 12)
    Dim i As Long, j As Long, p As Long, n As Long
    Dim ch As String
    Dim Chars1 As String, Words1() As String

    n = Len(Chars)
    Select Case n
        Case Is > 1
            p = 1: For i = 2 To n - 1: p = p * i: Next '-- p = (n-1)!
            ReDim Words1(1 To p)
            If Not bPredim Then ReDim Words(1 To n * p)
            For i = 1 To n
                ch = Mid$(Chars, i, 1)
                Chars1 = Left$(Chars, i - 1) & Mid$(Chars, i + 1)
                BuildWords Chars1, Words1, True
                For j = 1 To p
                    Words((i - 1) * p + j) = ch & Words1(j)
                Next
            Next
        Case 1
            If Not bPredim Then ReDim Words(1 To 1)
            Words(1) = Chars
        Case 0
            Words = Split("")
    End Select
End Sub

Sub Test_BuildWords()
    Dim Chars As String
    Dim Words() As String
    Dim i As Long
    Dim t As Single
    
    Chars = "abcefghij"
    '-- with 9 characters, 362880 words will be generated
    t = Timer
    BuildWords Chars, Words
    t = Timer - t
    'For i = 1 To UBound(Words)
    '    Debug.Print i; Words(i)
    'Next
    Debug.Print UBound(Words), t
End Sub

[akhileshbc]

Thanks anhn...

[Spoo]

What will be the best way to check if it's an actual word in English. I mean, upon generating the words, I would check the words with a list of words in textfile (which are valid words in English), to find whether it exists in English language.

Do you have any tweaks or ideas to make it faster ?
Currently, I will grab all the words into an array on apllication startup. And then, loop through those arrays to find a matching word.

I think instead of looping through the arrays, can't we Join the array to a single string, and then check the existence of the word using Instr() in the string variable ?

Guys, what do you think ? Any ideas ?

Akhil

One thought.. kind of like a google-search algo.

1. Put all the English words in an array (say, 1,000,000 words)
2. In another array, create "level 1 pointers". For example

• "a" begins at 1
• "b" begins at 38,000 (ie, the first word that begins with the letter "b")
• "c" begins at 68,205
• ...
• "w" begins at 900,000
• etc.

This would be a 1-time endeavor

• You could take this several levels deep, if that would be helpful.
• Downside is that if new English words are added, you'd need to redo this

Then you're ready to look at the list of your "generated" words.

• if your word begins with "a", piece of cake
• if your word begins with "w", instead of needing the first
  900,000 interations, you could begin at 900,000... that would be faster.

Does that get you started?

Spoo

[akhileshbc]

That's a nice idea Spoo...

Thanks. I will try that one...

Do you have any comments about my post #13 ?

[Milk]

<snip>What will be the best way to check if it's an actual word in English.

If your looking to make an anagram solver then you should be going about this in a completely different way. Using a twelve letter anagram as an example, assuming it contains twelve unique characters, it will have 479'001'600 different permutations. Only a very small portion of these permutations will be actual words eg < 8. It's a complete waste of time and memory to calculate all the permutations then check if it is a word or not.

Have a look at this recent thread (#4+), and see if you understand what I'm on about (I'm not sure the OP did)

I think the approach might help indirectly with the problem that post #13 alludes to.

[Spoo]

Akhil

Sorry, at the moment, I don't.

I get what you're trying to do, but as my initial attempt
at the basic algo was incomplete, and as I haven't had
time to study "array shifting", I'm afraid I'm just an outsider
at this point.

EDIT
Thank goodness Milk is on the job!

Spoo

[akhileshbc]

Thanks guys...

It will took some hours for me to understand the idea. So, after understanding it, I will post my doubts and the codes.

Thanks again....

[akhileshbc]

@Milk: As I was reading your posts on the other thread several times, the code generation is not clear to me. Assigning numbers to characters ?
Can you provide an example ?

Thanks again...

[Milk]

You could try a function like this...

Private Function ScoreWord(Word As String) As Long
  Dim buf() As Byte, i As Long, score As Long

  If Len(Word) < 32 Then
    score = score Or (Len(Word)) * &H4000000
    buf = StrConv(LCase$(Word), vbFromUnicode)
    For i = 0 To UBound(buf)
      If buf(i) > 96 And buf(i) < 122 Then
          score = score Or 2 ^ (buf(i) - 97)
      Else
          ScoreWord = -1 'indicates word contains illegal letters
          Exit Function
      End If
    Next i
    ScoreWord = score
  Else
    ScoreWord = -2 'indicates word is too long
  End If
  
End Function

Depending on the bigger picture you might want something a little different. The raise operator (^) is very slow, it could well be a good Idea to keep a module level array of Bit values (1, 2, 4, 8... ...536870912, 1073741824, -2147483648) to use for getting/setting bits. The score gives no indication of the order of the letters, it indicates which letters are present and how long the word is

Have a look at the words and associated scores in the example. All the words with equal score are possibly an anagram of each other. For any set of letters (<32) you can generate a score and compare it to the scores in the list.

[akhileshbc]

Thanks Milk....

I will try that, and will post the doubts tomorrow (It is 10.30pm here )

[akhileshbc]

You could try a function like this...

Private Function ScoreWord(Word As String) As Long
  Dim buf() As Byte, i As Long, score As Long

  If Len(Word) < 32 Then
    score = score Or (Len(Word)) * &H4000000
    buf = StrConv(LCase$(Word), vbFromUnicode)
    For i = 0 To UBound(buf)
      If buf(i) > 96 And buf(i) < 122 Then
          score = score Or 2 ^ (buf(i) - 97)
      Else
          ScoreWord = -1 'indicates word contains illegal letters
          Exit Function
      End If
    Next i
    ScoreWord = score
  Else
    ScoreWord = -2 'indicates word is too long
  End If
  
End Function

Depending on the bigger picture you might want something a little different. The raise operator (^) is very slow, it could well be a good Idea to keep a module level array of Bit values (1, 2, 4, 8... ...536870912, 1073741824, -2147483648) to use for getting/setting bits. The score gives no indication of the order of the letters, it indicates which letters are present and how long the word is

Have a look at the words and associated scores in the example. All the words with equal score are possibly an anagram of each other. For any set of letters (<32) you can generate a score and compare it to the scores in the list.

Thanks Milk...

Milk, I'm trying to learn the idea. But a small question, is "z" an invalid character ?

[akhileshbc]

Ok. I think, I got the idea. I will say it. Correct me if I'm wrong.

Phase1:
First, I will generate numerical codes for all the words available with me.
Then sort it according to the codes.
Done !

Phase2:
Then, in the word generator, when all possible combinations of words are generated based on the string inputted by the user (using one of the methods posted in this thread - permutations).
Then, corresponding numerical codes are also generated for this generated words.
Done !

Phase3:
Then, these codes of the newly generated words are searched with those in which are generated in the first phase (available words list). If a match is found, then display it.
Done !

Am I right ?
Did I missed something ?

[Milk]

Oops no , should be <= 122 or < 123, but you know that

[akhileshbc]

Oops no , should be <= 122 or < 123, but you know that

Ok. Thanks...

[Milk]

<snip>Phase2:
Then, in the word generator, when all possible combinations of words are generated based on the string inputted by the user (using one of the methods posted in this thread - permutations).
Then, corresponding numerical codes are also generated for this generated words.

Ahh, no. You don't have to generate all the possible combinations (this is the whole point of scoring the words in such a way)

User inputs a string, the string is given a score. Compare this new score to the stored scores. If a match is found then check to see if they both contain the same letter duplicates (if any)

You can be inventive with the various bitwise operators to make more complicated queries, such as using wildcards as in post #13

[akhileshbc]

Ahh, no. You don't have to generate all the possible combinations (this is the whole point of scoring the words in such a way)

User inputs a string, the string is given a score. Compare this new score to the stored scores. If a match is found then check to see if they both contain the same letter duplicates (if any)

Thanks Milk... Now I got the idea...

You can be inventive with the various bitwise operators to make more complicated queries, such as using wildcards as in post #13

Sorry to ask again. But can you explain this idea ?
And which are the bitwise operators in VB ? ("<<" and ">>" ?)

[Milk]

Not And Or Xor are VBs bitwise operators

A wildcard search could work like this...

User enters a string with wildcards "tomb???"

The string is scored to get 470306818 (function above won't like the ?s, it would need to be adjusted)
The high bits of the score would indicate the length (7 -> 469762048)
The low bits would indicate the letters ("tomb" -> 544770)

To search for all the 7 letter words that contain the letters "tomb" we need to look for scores >= 470306818, < 536870912 (8 letters) which also share the same letter bits.

Const ALPHABETSIZE As Long = 26
Const SIZESHIFT As Long = 2^ALPHABETSIZE
Const LETTERMASK As Long = SIZESHIFT - 1
Const SIZEMASK = Not LETTERMASK Xor &H80000000 '(not using the highest bit)

'FindIndex() is an imaginary binary search function that returns an index to a word
'if the passed score does not exist then it returns the next

For i = FindIndex(Score) to FindIndex((Score And SIZEMASK) + LETTERMASK) - 1
   If (WordScores(i) Or Score) = WordScores(i) Then 'same length and contains same letters
      'Check letter duplicates and other letters do not exceed number of wildcards
      '...

An anagram search could be...

   i = FindIndex(Score)
   Do While WordScores(i) = Score
      'Check for letter duplicates
      i = i + 1
   Loop

[akhileshbc]

Thanks Milk...

I understand the idea(your explanation). But the code you provided (that includes constants), is little difficult for me to understand. (I will try to play with it to know more)

But can you do one more favor ? Can you explain these constants(I mean, what it holds by providing a small example, like you did with "tomb???"):

ALPHABETSIZE
SIZESHIFT
LETTERMASK
SIZEMASK

Thanks again...

[Milk]

The numbers those constants represent are useful you will find they get used quite often (eg in the ScoreWord function, score = score Or (Len(Word)) * SIZESHIFT). They should be stored at a modular level. By using similar constants rather than literals you create code which is more flexible.

ALPHABETSIZE is only used to define the other constants (26 is easy to remember and understand)
SIZESHIFT is the multiplier for the word length part of the score. (Score \ SIZESHIFT = word length)
LETTERMASK is the bit mask for the letter part of the score. (Score And LETTERMASK = letter score)
SIZEMASK is the bit mask for the length part of the score. (Score And SIZEMASK = length score)

I just noticed a typo

FindIndex((Score And SIZEMASK) + LETTERMASK) - 1

The above line finds the highest word index in that size group. Score And SIZEMASK gets just the length part, then by adding (or Or) the LETTERMASK you end up with the highest possible score. FindIndex() will not find a word with the actual score (eg. 7 letters and contains the whole alphabet) so it will return the next, which will be the first word of the next size group, hence the -1.

[akhileshbc]

Thanks Milk....