Comparing characters in two strings and looking for a difference

[dgparryuk]

Hi Everyone,

i've just spent 2 hours searching and trying lots of solutions to this from what i found and nothing is quite right for what I want. I'm trying to play with words and find word patterns, i'm trying to find anagrams of words with an extra letter

eg

mod - mood
mod - doom
mod - mode
dos - mods
ood - doom

so my nice simple code was

For y = 1 To Len(firstword)
                    For x = 1 To Len(secondword)
                        firstletter = Mid(firstword, y, 1)
                        secondletter = Mid(secondword, x, 1)
                            If firstletter = secondletter Then
                                secondwordcount = secondwordcount + 1
                                Exit For ' this fixed some double letter issues but not all
                            Else
                                secondwordcount = secondwordcount
                                
                            End If
                    Next x
                Next y
If secondwordcount = 3 Then

and then check how many letters match

so mod-mode would count 3
dos to mods would also count 3
but mod to mood would count 6 - m-1 o-2 o-2 d-1

i tried removing double letters from the shorter word and changing the calculation based on that
od(ood) to mood would be 3 great
od(ood) to doda would also come out as 3 - d-2 o-1

and not all words are 3 & 4 letters, the longest words are 10 letters long
ABANDONER & ABANDONERS which 9 letters are the same but double A & double N would count 13

as part of other bits i've been doing i do have a list of all the words sorted in alphabetical character order so MOD would be DMO and MOOD would be DMOO, not sure if that would be helpful for this in anyway but thought i'd throw it in incase someone came up with the idea

 

[Fuji]

Is this what you are after?

Sub test()
    Dim e
    For Each e In Array(Array("MOD", "MOOD"), Array("ABANDONER", "ABANDONERS"), _
                                  Array("mod", "doom"))
        MsgBox e(0) & " : " & e(1) & vbLf & vbLf & CountMatch(e(0), e(1)), , e(0) & " : " & e(1)
    Next
End Sub

Function CountMatch(ByVal s1$, ByVal s2$) As Long
    Dim i&, temp$
    For i = 1 To Len(s1)
        temp = Replace(s2, Mid$(s1, i, 1), "", , 1, 0)
        If s2 <> temp Then CountMatch = CountMatch + 1
        s2 = temp
    Next
End Function

 

[dgparryuk]

That was absolutely perfect

Thank you SO much