Unscramble word using data from spreadsheet. 2

[Zappd]

Hello,

How do I unscramble a word using data from the spreadsheet for words that match?
I only want to search the words on the spreadsheet, not an entire dictionary.
The columns are A to E and each has a header.
Word length will be 3 to 7 letters.
As an example if seu was searched it would return something like:
use
sue
sued
sues
ruse
used
user
uses

Tried using examples for these threads and was unable to get anything to work.
thread707-1458309: Word Descrambler Word Descrambler
thread222-1195039: Word puzzle / unscramble Word puzzle / unscramble

Attached is the spreadsheet I'm using.

Please let me if there are any questions.
Zappd

 

[strongm]

>Word puzzle / unscramble Word puzzle / unscramble

You might struggle with that one, since it is an example of VB.NET, which pretty much has nothing to do with classic VB or with VBA (it ended up in the VB6/6 forum because of a forum tidy up exercise that went badly wrong a while back)

 

[Andrzejek]

What exactly are your requirements?
Are you saying: If user searches for [tt]s e u[/tt], you want to return:
[ul][li]all words that contain all those 3 letters in any order[/li]
[li]and there are no other letters between s, e, and u?[/li]
[/ul]
BTW, it is risky to download and open xls[red]m[/red] file.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Zappd]

Andy,

Apologize for the bad explanation.
It would search columns A to E to find any word that contains the letters provided in the search text box.
In this example four would be the maximum word length because that is the number of letters that was entered in the textbox and searched.
The columns contain words that are 3,4,5,6 and 7 letters long and each column has a header.

If searching for words that contain the letters ecra I would like for it to return something like below:

ace
arc
aces
acre
care
lace
race

Currently I'm able to search but only if the letters are in order.
So searching ecra would find nothing.
Please let me know if you have more questions.

Thanks,
Micah

 

[Andrzejek]

You provided examples (which is nice) but whoever will try to help you needs clear and complete rules, requirements, specifications.
I quoted two rules (guesses) in my bullets, and already looks like my second bullet was wrong :-(

Do you have a clear 'business' need?
Or is it simple 'academic' exercise?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[strongm]

>but only if the letters are in order

You are so close to one of the main ways of solving this ..

Imagine sorting each string (both the ones being tested and the test string) being sorted into alphabetic order

ecra would become acer

and

care would become acer

I'll leave you with that thought ...

 

[Zappd]

Andy,
Thanks for your patience.

Rules:
Search columns A to E for any word that matches the letters entered into the seach box.
Requirement:
Word size will be from 3 to 7 letters in length.
Specifications:
List found words in listbox.

I'm creating this to help my wife with a word game that she plays and she wanted something that she could add words to and search easily.
I have everything but the search function complete. As stated earlier I can search for a particular word, or part of a word if it's in order

That's why I already have words in columns A to E and those columns are all that is searched.

strongm,
If acer and care were both found in the search of columns A to E then that would be what I wanted.
Have tried different search combinations using range.find method and tried some INSTR functions but have not been able to figure it out.

Here is the search code I'm trying to use.

Sub Search()
 '''''Search for data, part 1 of 2
    Workbooks("WordSearch.xlsm").Activate
    Dim shtSearch As Worksheet
    
    lstbxView.Clear
            
    For Each shtSearch In ThisWorkbook.Worksheets
        Locate tbSearch.Text, shtSearch.Range("A:E")
    Next
    tbSearch.SetFocus
   
    If lstbxView.ListCount = 0 Then
        Call NotFound
    End If
End Sub
'''''Search for data, part 2 of 2
Sub Locate(Name As String, Data As Range)
    On Error Resume Next
    Dim rngFind As Range
    Dim strFirstFind As String
    
    With Data
        
        Set rngFind = .Find(Name, LookIn:=xlValues, LookAt:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            Do
                If rngFind.Row > 1 Then
                    lstbxView.AddItem rngFind.Value
                    lstbxView.List(lstbxView.ListCount - 1, 1) = Data.Parent.Name
                    lstbxView.List(lstbxView.ListCount - 1, 2) = Data.Parent.Name & "!" & rngFind.Address
                    
                End If
                Set rngFind = .FindNext(rngFind)
             Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
        Call B4add
    End With
End Sub

 

[combo]

You've got pretty simple algorithm from strongm. Sort letters in the template, sort letters in entry words and compare (Instr or Replace) sorted strings.
Assign data from non-empty columns to variant array and process every word in VBA. You only need a function that returns sorted string.

combo

 

[strongm]

>n this example four would be the maximum word length because that is the number of letters that was entered in the textbox
>I can search for a particular word, or part of a word if it's in order

These two statements don't align (and when combined with your example output of 15 Nov 21 22:43, things are further confused) What is your matching requirement?

The former, an exact anagram, can be easily solved with the alpha sort concept I mentioned above.

The latter takes tiny bit more thought, but is not much more complicated ... essentially just remove letters contained in the test word from the word being tested. If you are left with a null string or a string whose length is equal to the (length of the string being tested minus the length of the testee string) then you have a partial match

 

[Andrzejek]

I’ve asked for “clear and complete rules”, but – as you can see – people poke holes in your explanations.
Over the years (25+) I have found that the hardest part of my work as a programmer is to squeeze all the rules out of whoever asks for a program. In my opinion, that’s about 75% (or more) of a success: to know exactly what the person actually needs. All other work, programming itself, is easy (and fun, too). I do know that people who provide the information feel that they do good job of explanation because they (usually, not always) know what they want. But way too often we find ourselves in the situation of: this is exactly what I’ve asked for, but that’s not want I need. Some of my clients wanted to send me to a mind reading class to help with this issue, but – unfortunately - I could not find such a class anywhere.

Please, don’t take it as a personal attack, just an observation.



---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Zappd]

No problem.
Thought I was providing the required information.
How about this.
I have a searchable spreadsheet with words in columns A to E.
The words are from 3 to 7 letters in length.
Column A is 3 letter words, B is four letter words and so on until E which is 7 letter words.
I want to be able to search those columns for a word that matches the letters I enter in to a search text box.
Using my example above:
If searching for words that contain the letters ecra I would like for it to return something like below:
It would return these words because I'm only using four letters in the search and these words are in one of the columns.
It's only searching for word in columns A to E.
ace
arc
aces
acre
care
lace
race

My first example using seu was bad because I added four letter words in the result. (my bad, sorry)
I have tried to use this code but am unable to figure out how to get it to pull from the spreadsheet columns or output to the listbox.
thread707-1458309

Sub Permutations()
' Select a string, then run the macro
Dim strTest As String
Dim strOut, strVal, strChk As Boolean
Dim i As Long, j As Long, pos As Long, k As Long, l As Long, m As Long
strTest = LCase(InputBox("Input word or letters to be descrambled.", "Word Descrambler"))
strOut = Mid(strTest, 1, 1)
strOut = StringString(2, strOut & " ")
strOut = RTrim(strOut)
strChk = False

For j = 2 To Len(strTest)
    strOut = Split(strOut, " ")
    ' weave
    For i = 0 To UBound(strOut)
        pos = i Mod (2 * j)
        pos = pos - (j - 1)
        Select Case pos
        Case Is <= 0
            pos = Abs(pos)
        Case Else
            pos = pos - 1
        End Select
        strOut(i) = InsertString((strOut(i)), _
        Mid(strTest, j, 1), pos)
    Next i
    If j < Len(strTest) Then
        For i = 0 To UBound(strOut)
        strOut(i) = _
          StringString(j + 1, strOut(i) & " ")
        Next i
    End If
    strOut = Join(strOut, " ")
    strOut = Replace(strOut, "  ", " ")
    strOut = RTrim(strOut)
Next j
strOut = Split(strOut, " ")
For k = 0 To UBound(strOut)
    For l = 3 To Len(strOut(k))
        If Application.CheckSpelling(Left(strOut(k), l)) = True Then
            If strVal <> "" Then
                strVal = Split(strVal, ", ")
                For m = 0 To UBound(strVal)
                    If strVal(m) = Left(strOut(k), l) Then
                        strChk = True
                        Exit For
                    End If
                Next m
                strVal = Join(strVal, ", ")
                strVal = Replace(strVal, "  ", " ")
                strVal = RTrim(strVal)
                If strChk = False Then strVal = strVal + ", " + Left(strOut(k), l)
                strChk = False
            Else
                strVal = Left(strOut(k), l)
            End If
        End If
    Next l
Next k
strOut = Join(strOut, " ")
strOut = Replace(strOut, "  ", " ")
strOut = RTrim(strOut)

MsgBox "Valid words created from given letters are listed below:" & vbLf & vbLf & strVal

End Sub
Function InsertString(strOld As String, strInsert As String, pos As Long) As String
' Inserts strInsert into strOld at position pos
InsertString = Left(strOld, pos) & strInsert & Mid(strOld, pos + 1)
End Function
Function StringString(imax As Long, myString As String) As String
' Comparable to String(). Creates string of imax times the string myString
Dim i As Long
If imax < 0 Then MsgBox "imax < 0", vbCritical
i = 0
StringString = ""
Do While i < imax
    Select Case i
    Case 0, Is >= imax / 2
        StringString = StringString & myString
        i = i + 1
    Case Else
        StringString = StringString & StringString
        i = 2 * i
    End Select
Loop
End Function

I appreciate your patience.
Micah

 

[strongm]

> for a word that matches the letters

It is how you define 'match' that is causing a problem. How does ecra match lace for example? I'm assuming you've made another error in your example output, but I don't know for sure.

There's not a lot of point showing us example code that you state does NOT do what you want (it is designed to generate all anagrams of an input string, then use the spell checker to see if a specific anagram is an actual word)

Please be explicit by what you mean by 'Match'

 

[strongm]

Here's an example of how you might do this. Note the word example: It is NOT a full solution to your issue, but is much more appropriate than the example code you are currently trying to use. You need a UserForm with a listbox, a textbox and a command button. Then paste in code below. Note the comments that are pretty explicit about what is considered a 'match' Also note that it makes no assumptions abpout the range being searched, that's up to you - the example happens to use the full populated range (i.e all columns A-E) from the example spreadsheet you posted.

[blue]Option Explicit

[COLOR=green]' If the word being tested is shorter than search string, then match if all letter in word being tested are in the search string
' If word being tested is same length as search string, then match if word is exact anagram of search string
' If word being tested is longer than search string, then match if all letters in search string are in word being tested
' Character order and proximity are not evaluated[/color]
Public Function partmatch(ByVal strTest As String, ByVal StrSearch As String) As Boolean
    Dim lp As Long
    Dim keep As Long
    keep = Len(strTest)
    If Len(strTest) > 0 And Len(StrSearch) > 0 Then
        [COLOR=green]' Remove any matching characters that are in the testing string.[/color]
        For lp = 1 To Len(StrSearch)
            strTest = Replace(strTest, Mid$(StrSearch, lp, 1), "", , 1)
        Next
        partmatch = (keep - Len(StrSearch) = Len(strTest)) Or Len(strTest) = 0 ' did we match all the characters?
    End If
End Function

Private Sub Search(myRange As Range)
    Dim cell As Variant
    ListBox1.Clear
    For Each cell In myRange 'enumerating a range goes across, then down, so may want to sort results
        [COLOR=green]' you could add additional conditions here,  if eg you wanted to filter out matches that are longer than the search word[/color]
        If partmatch(LCase(cell), LCase(TextBox1.Text)) Then ListBox1.AddItem cell
    Next
End Sub

Private Sub CommandButton1_Click()
    Search Range("A2:E624") [COLOR=green]' Your range may differ. For purposes of this example I was using the spreadsheet you provided[/color]
End Sub[/blue]

 

[Andrzejek]

>Column A is 3 letter words, B is four letter words and so on until E which is 7 letter words.
>If searching for words that contain the letters ecra I would like for it to return something like below:
OK, looking for ecra...

>It would return these words because I'm only using four letters in the search and these words are in one of the columns.
Wrong. Four letters long words are in column B, but you also return three letters words, which are in column A

>It's only searching for word in columns A to E.
Wrong again. Since you have entered a 4 letter word (ecra), you would only search columns A and B. Right?
Edit: wrong, I mean I was wrong to call it wrong.
Unless you add another requirement: If searching for a word 'xcat' return 'cat'

>ace
>arc
>aces - looking for ecra, where is r in aces???
>acre
>care
>lace - looking for ecra, where is r in lace???
>race

See what I mean by clear and complete rules?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Zappd]

Strongm,

That was what I was trying to get.
I will work on filtering out the matches longer than the search word and try to get it to sort by smallest to largest.
Doing some searches on that so sure I will get there eventually but you helped with what I was having an issue with.
Thanks again for your patience and my mistypes like aces and lace.

Micah

 

[Andrzejek]

If you search for [tt]'aabb'[/tt], do you get only words where you have 2 a's and 2 b's (abba, baba, xabybaz) or do you accept words with just 1 a and 1 b?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Andrzejek]

Going with strongm suggestion from his post on 16 Nov 21 16:30...

Option Explicit

Sub StartHere()
Dim aryWords(6) As String
Dim strSearch As String
Dim strTemp As String
Dim a As Integer

aryWords(0) = "ace"
aryWords(1) = "arc"
aryWords(2) = "aces"
aryWords(3) = "acre"
aryWords(4) = "care"
aryWords(5) = "lace"
aryWords(6) = "race"

strSearch = "ecra"

strTemp = SortWord(strSearch)
For a = LBound(aryWords) To UBound(aryWords)
    If InStr(SortWord(aryWords(a)), strTemp) = 0 Then
        MsgBox aryWords(a) & " NOT found when searched in " & strSearch
    Else
        MsgBox aryWords(a) & " found in " & strSearch
    End If
Next a

End Sub

Function SortWord(ByRef strIn As String) As String
Dim i As Integer
Dim j As Integer
Dim x As String
Dim ary() As String

For i = 1 To Len(strIn)
    x = x & Mid(strIn, i, 1) & " "
Next i
x = Left(x, Len(x) - 1)
ary = Split(x, " ")

For i = LBound(ary) To UBound(ary) - 1
    For j = i + 1 To UBound(ary)
        If ary(i) > ary(j) Then
            x = ary(j)
            ary(j) = ary(i)
            ary(i) = x
        End If
    Next j
Next i
x = Join(ary, "")[green]
'SortWord = Join(ary, "")

'Exit Function
'''Remove multiple letters[/green]
Dim strX As String
For i = 1 To Len(x)
    If InStr(strX, Mid(x, i, 1)) = 0 Then
        strX = strX & Mid(x, i, 1)
    End If
Next i

SortWord = strX

End Function

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Zappd]

>>If you search for 'aabb', do you get only words where you have 2 a's and 2 b's (abba, baba, xabybaz) or do you accept words with just 1 a and 1 b?

There are five columns containing words that will be searched/found.
A=3 letter words, B=4 letter words and so on until E which contains 7 letter words.

The below is according to your question.
Yes and yes, it could find three and four letter words that contain either two a's or b's in columns A and B since that is the search criteria you provided.
It would only search columns A and B, because column A contains three letter words and column B contains four letter words.
Searching for aabb:
If aba or bab were words in column A it would find them.
If abba or baba were words in column B it would find them.
Yes it accepts one a or b as in the above example aba or bab as long as they are in columns A or B and it contains only a's or b's.
It would also find aab, baa, bba, baab, abab, and so on if they were in the columns A or B.

It would not find cab, lab, jab, jala or lava because they contain letters other than a and b (which is all we are searching for in your example).
It would not find xabybaz as in your example because it contains letters other than a and b AND it's more than four letters in length.

 

[mikrom]

Hi all,

I read this thread and wondered why no one mentioned the regular expressions.

Why to develop some new algorithms and not to use already proven algorithms - namely the regular expressions ?

I tried this:

1) First I created a function that tests if the cell content match a given pattern

[COLOR=#804040][b]Function[/b][/color] regex_test[COLOR=#804040][b]([/b][/color]cell [COLOR=#804040][b]As[/b][/color] Range[COLOR=#804040][b],[/b][/color] pattern_string[COLOR=#804040][b])[/b][/color] [COLOR=#804040][b]As[/b][/color] [COLOR=#2e8b57][b]Boolean[/b][/color]
    [COLOR=#804040][b]Dim[/b][/color] regex [COLOR=#804040][b]As[/b][/color] [COLOR=#804040][b]New[/b][/color] RegExp
                  
    [COLOR=#804040][b]With[/b][/color] regex
        [COLOR=#804040][b].[/b][/color]Global [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]True[/color]
        [COLOR=#804040][b].[/b][/color]MultiLine [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]True[/color]
        [COLOR=#804040][b].[/b][/color]IgnoreCase [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]False[/color]
        [COLOR=#804040][b].[/b][/color]Pattern [COLOR=#804040][b]=[/b][/color] pattern_string
    [COLOR=#804040][b]End[/b][/color] [COLOR=#804040][b]With[/b][/color]
        
    input_string [COLOR=#804040][b]=[/b][/color] cell[COLOR=#804040][b].[/b][/color][COLOR=#a020f0]Value[/color]
    [COLOR=#804040][b]If[/b][/color] regex[COLOR=#804040][b].[/b][/color]test[COLOR=#804040][b]([/b][/color]input_string[COLOR=#804040][b])[/b][/color] [COLOR=#804040][b]Then[/b][/color]
        regex_test [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]True[/color]
    [COLOR=#804040][b]Else[/b][/color]
        regex_test [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]False[/color]
    [COLOR=#804040][b]End[/b][/color] [COLOR=#804040][b]If[/b][/color]
[COLOR=#804040][b]End[/b][/color] [COLOR=#804040][b]Function[/b][/color]

2) Then I created a subroutine which iterates over all cells from given range, on every cell it calls the function regex_test() and if the match is true then it colors the content of the cell to red.

[COLOR=#804040][b]Sub[/b][/color] search_cells[COLOR=#804040][b]()[/b][/color]
    [COLOR=#804040][b]Dim[/b][/color] cell_range [COLOR=#804040][b]As[/b][/color] Range[COLOR=#804040][b],[/b][/color] cell [COLOR=#804040][b]As[/b][/color] Range
    [COLOR=#804040][b]Set[/b][/color] cell_range [COLOR=#804040][b]=[/b][/color] Range[COLOR=#804040][b]([/b][/color][COLOR=#ff00ff]"A1:E20"[/color][COLOR=#804040][b])[/b][/color]
    chars [COLOR=#804040][b]=[/b][/color] [COLOR=#008080]InputBox[/color][COLOR=#804040][b]([/b][/color][COLOR=#ff00ff]"Enter characters to search for"[/color][COLOR=#804040][b])[/b][/color]
    pattern_string [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]"["[/color] [COLOR=#804040][b]+[/b][/color] chars [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]"]"[/color]
    [COLOR=#008080]MsgBox[/color] [COLOR=#ff00ff]"Characters entered : "[/color] [COLOR=#804040][b]+[/b][/color] chars [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]vbCrLf[/color] [COLOR=#804040][b]+ _[/b][/color]
           [COLOR=#ff00ff]"Pattern String : """[/color] [COLOR=#804040][b]+[/b][/color] pattern_string [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]""""[/color]
    [COLOR=#804040][b]For[/b][/color] [COLOR=#804040][b]Each[/b][/color] cell [COLOR=#804040][b]In[/b][/color] cell_range
        [COLOR=#804040][b]If[/b][/color] regex_test[COLOR=#804040][b]([/b][/color]cell[COLOR=#804040][b],[/b][/color] pattern_string[COLOR=#804040][b])[/b][/color] [COLOR=#804040][b]Then[/b][/color]
            cell[COLOR=#804040][b].[/b][/color]Font[COLOR=#804040][b].[/b][/color]Color [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]vbRed[/color]
        [COLOR=#804040][b]Else[/b][/color]
            cell[COLOR=#804040][b].[/b][/color]Font[COLOR=#804040][b].[/b][/color]Color [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]vbBlack[/color]
        [COLOR=#804040][b]End[/b][/color] [COLOR=#804040][b]If[/b][/color]
    [COLOR=#804040][b]Next[/b][/color] cell
[COLOR=#804040][b]End[/b][/color] [COLOR=#804040][b]Sub[/b][/color]

For example I have in Columns A - E these words (see the screenshot), then clicking on the button I call the subroutine, which colors the matched cells red (see the screenshot).

If the results does not fullfil the expectations of the OP, the OP have only to change the regex pattern in the subroutine

pattern_string = "[" + chars + "]"

 

[strongm]

Doesn't meet the requirements