Return True if there are any common letters between two strings

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Return True if there are any common letters between two strings

Post by YasserKhalil »

Hello everyone
Suppose I have two strings "abcd" and "cfgh!!#v"
How can I return True here as there is the letter c is intersection in both strings?
Searching for the simplist approach and try to avoiding loops.
Thanks a lot.

User avatar
HansV
Administrator
Posts: 78235
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Return True if there are any common letters between two strings

Post by HansV »

I don't see how you could avoid using a loop - you'll need to look at individual characters.
Try this:

Code: Select all

Function Common(s1 As String, s2 As String) As Boolean
    Dim n1 As Long, n2 As Long, i As Long
    n1 = Len(s1)
    n2 = Len(s2)
    If n1 < n2 Then
        For i = 1 To n1
            If InStr(s2, Mid(s1, i, 1)) Then
                Common = True
                Exit Function
            End If
        Next i
    Else
        For i = 1 To n2
            If InStr(s1, Mid(s2, i, 1)) Then
                Common = True
                Exit Function
            End If
        Next i
    End If
End Function
For efficiency, the code loops through the characters of the shortest string
Example usage:

Code: Select all

Sub Test()
    Debug.Print Common("abcd", "cfgh!!#v")
    Debug.Print Common("abcd", "efgh!!#v")
End Sub
This returns

Code: Select all

True
False
On my computer, Common("abcd", "cfgh!!#v") takes 0.00000042 seconds, and Common("abcd", "efgh!!#v") takes 0.00000053 seconds.
Best wishes,
Hans

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Return True if there are any common letters between two strings

Post by Doc.AElstein »

Here some ideas using Dictionaries.

They don't seem to be as quick as Hans macro

Code: Select all

'    https://eileenslounge.com/viewtopic.php?f=30&t=36382
Option Explicit
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
 Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
 
Function MicroTimer() As Double
Dim cyTicks1 As Currency: Static cyFrequency As Currency
 Let MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec
 Call getTickCount(cyTicks1) ' get ticks
    If cyFrequency Then Let MicroTimer = cyTicks1 / cyFrequency ' calc seconds
End Function

Sub Tests()
Debug.Print "ComonEileen (Alan)"  '  ' For if no duplicates in either word
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

Debug.Print
Debug.Print "ComonEileen2 (Alan)" ' For if there might be duplicates in words
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")


Debug.Print
Debug.Print "CommonH ( Hans )"
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

End Sub



' For if no duplicates in either word
Sub Test1()
Debug.Print "ComonEileen (Alan)"
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary
Dim Cnt As Long
    For Cnt = 1 To Len(s1 & s2)
     Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
    Next Cnt
    If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen = True
End Function

' For if there might be duplicates in words
Sub Test2()
Debug.Print
Debug.Print "ComonEileen2 (Alan)"
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen2(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary, Dik1 As Scripting.Dictionary, Dik2 As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary: Set Dik1 = New Scripting.Dictionary: Set Dik2 = New Scripting.Dictionary
Dim Cnt As Long
    For Cnt = 1 To Len(s1)
     Let Dik1(Mid(s1, Cnt, 1)) = "Anything"
    Next Cnt
 Let s1 = Join(Dik1.Keys(), "")
    For Cnt = 1 To Len(s2)
     Let Dik2(Mid(s2, Cnt, 1)) = "Anything"
    Next Cnt
 Let s2 = Join(Dik2.Keys(), "")
    
    For Cnt = 1 To Len(s1 & s2)
     Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
    Next Cnt
    If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen2 = True
End Function

Sub TestHans()
Debug.Print
Debug.Print "CommonH ( Hans )"
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

End Sub
Function CommonH(s1 As String, s2 As String) As Boolean
    Dim n1 As Long, n2 As Long, i As Long
    n1 = Len(s1)
    n2 = Len(s2)
    If n1 < n2 Then
        For i = 1 To n1
            If InStr(s2, Mid(s1, i, 1)) Then
                CommonH = True
                Exit Function
            End If
        Next i
    Else
        For i = 1 To n2
            If InStr(s1, Mid(s2, i, 1)) Then
                CommonH = True
                Exit Function
            End If
        Next i
    End If
End Function
Alan
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Return True if there are any common letters between two strings

Post by YasserKhalil »

Awesome my tutor. Thank you very much.
I thought it is possible to use the LIKE operator or using regex to do such a task.

User avatar
HansV
Administrator
Posts: 78235
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Return True if there are any common letters between two strings

Post by HansV »

I found another algorithm on Google, but although it was faster than Alan's ingenious solution, it was slower than the one I proposed.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Return True if there are any common letters between two strings

Post by YasserKhalil »

Thanks a lot Mr. Alan, I didn't see your post as it was my sleep time.
Can you provide us with the algorithm you found Mr. Hans?

User avatar
HansV
Administrator
Posts: 78235
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Return True if there are any common letters between two strings

Post by HansV »

I modified the code found in Check if two strings have a common substring.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Return True if there are any common letters between two strings

Post by YasserKhalil »

Thanks a lot. But I didn't find a VBA code at the link.

User avatar
HansV
Administrator
Posts: 78235
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Return True if there are any common letters between two strings

Post by HansV »

No, I "translated" the Javascript code to VBA and modified it to handle more characters than just a-z.
Best wishes,
Hans

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Return True if there are any common letters between two strings

Post by Doc.AElstein »

Here I have added a couple of functions that use Dictionaries in a more conventional way, but they are all still quite a bit slower than Han's original offering

Code: Select all

'    https://eileenslounge.com/viewtopic.php?f=30&t=36382
Option Explicit
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
 Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
 
Function MicroTimer() As Double
Dim cyTicks1 As Currency: Static cyFrequency As Currency
 Let MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec
 Call getTickCount(cyTicks1) ' get ticks
    If cyFrequency Then Let MicroTimer = cyTicks1 / cyFrequency ' calc seconds
End Function

Sub Tests()
Debug.Print

Debug.Print "Indiginus (Alan)"
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print Indiginus("abcd", "cfgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print Indiginus("abcd", "efgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

Debug.Print
Debug.Print "Indiginus2 (Alan)"
 Let TimIt = MicroTimer
Debug.Print Indiginus2("abcd", "cfgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print Indiginus2("abcd", "efgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

Debug.Print
Debug.Print "ComonEileen (Alan)"  '  ' For if no duplicates in either word
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

Debug.Print
Debug.Print "ComonEileen2 (Alan)" ' For if there might be duplicates in words
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")


Debug.Print
Debug.Print "CommonH ( Hans )"
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

End Sub

Function ComonEileen(s1 As String, s2 As String) As Boolean  ' For if no duplicates in either word
Dim Dik As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary
Dim Cnt As Long
    For Cnt = 1 To Len(s1 & s2)
     Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
    Next Cnt
    If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen = True
End Function

Function Indiginus(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary
Dim Cnt As Long
    For Cnt = 1 To Len(s1)
     Let Dik(Mid(s1, Cnt, 1)) = "Anything"
    Next Cnt
    For Cnt = 1 To Len(s2)
     If Dik.Exists(Mid(s2, Cnt, 1)) Then Let Indiginus = True: Exit Function
    Next Cnt
End Function

Function Indiginus2(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary
Dim Cnt As Long
    If Len(s1) < Len(s2) Then
        For Cnt = 1 To Len(s1)
         Let Dik(Mid(s1, Cnt, 1)) = "Anything"
        Next Cnt
        For Cnt = 1 To Len(s2)
         If Dik.Exists(Mid(s2, Cnt, 1)) Then Let Indiginus2 = True: Exit Function
        Next Cnt
    Else
        For Cnt = 1 To Len(s2)
         Let Dik(Mid(s2, Cnt, 1)) = "Anything"
        Next Cnt
        For Cnt = 1 To Len(s1)
         If Dik.Exists(Mid(s1, Cnt, 1)) Then Let Indiginus2 = True: Exit Function
        Next Cnt
    
    End If
End Function

Function ComonEileen2(s1 As String, s2 As String) As Boolean  ' For if there might be duplicates in words
Dim Dik As Scripting.Dictionary, Dik1 As Scripting.Dictionary, Dik2 As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary: Set Dik1 = New Scripting.Dictionary: Set Dik2 = New Scripting.Dictionary
Dim Cnt As Long
    For Cnt = 1 To Len(s1)
     Let Dik1(Mid(s1, Cnt, 1)) = "Anything"
    Next Cnt
 Let s1 = Join(Dik1.Keys(), "")
    For Cnt = 1 To Len(s2)
     Let Dik2(Mid(s2, Cnt, 1)) = "Anything"
    Next Cnt
 Let s2 = Join(Dik2.Keys(), "")
    
    For Cnt = 1 To Len(s1 & s2)
     Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
    Next Cnt
    If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen2 = True
End Function

Function CommonH(s1 As String, s2 As String) As Boolean
    Dim n1 As Long, n2 As Long, i As Long
    n1 = Len(s1)
    n2 = Len(s2)
    If n1 < n2 Then
        For i = 1 To n1
            If InStr(s2, Mid(s1, i, 1)) Then
                CommonH = True
                Exit Function
            End If
        Next i
    Else
        For i = 1 To n2
            If InStr(s1, Mid(s2, i, 1)) Then
                CommonH = True
                Exit Function
            End If
        Next i
    End If
End Function


I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Guessed
2StarLounger
Posts: 102
Joined: 04 Feb 2010, 22:44
Location: Melbourne Australia

Re: Return True if there are any common letters between two strings

Post by Guessed »

I didn't do any speed tests but this seems to work without a loop

Code: Select all

Sub TestSubfind()
  If "efghijklmnopqrstuvwxyz!!#v" Like "*[ABCDEFGHIJKLMNOPabcd]*" Then
     Debug.Print "Match!"
  End If
End Sub
Credit: I found the method on this page https://analystcave.com/vba-like-operator/
Andrew Lockton
Melbourne Australia

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Return True if there are any common letters between two strings

Post by YasserKhalil »

Thanks a lot Guessed for sharing and for the new trick.

User avatar
Guessed
2StarLounger
Posts: 102
Joined: 04 Feb 2010, 22:44
Location: Melbourne Australia

Re: Return True if there are any common letters between two strings

Post by Guessed »

You will need to be careful on the allowed search characters since using the Like command means that characters such as * and [ and ] will be problematic to search for.
Andrew Lockton
Melbourne Australia

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Return True if there are any common letters between two strings

Post by YasserKhalil »

Is there a way to avoid those characters and treat them as literal characters, not special characters?

User avatar
HansV
Administrator
Posts: 78235
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Return True if there are any common letters between two strings

Post by HansV »

To use [, ], ? or * in the string on the right hand side of Like, enclose them in [ ].
So [[] looks for the literal character [, []] looks for the literal character ], [?] for ? and [*] for *.
Best wishes,
Hans

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Return True if there are any common letters between two strings

Post by Doc.AElstein »

HansV wrote:
09 Apr 2021, 07:18
To use [, ], ? or * in the string on the right hand side of Like, enclose them in [ ]....
Hi Hans,
I am not quite sure what you are saying. - Assuming that the “string on the right hand side of Like” would be one of the strings, ( like your s1 or s2 ) , then you would just use the Wildcard things as normal characters.... I think ... maybe...


To better explain what I mean. .. Lines 41 and 42 seem to be the way to do it. But I interpreted what you said to be like line 31 and 32, which does not seem to work. I might likely have misunderstood what you said
In short: it seems that in the solution offered by Guessed, you don’t need to make any extra allowance for using the Wildcard characters as literal

Code: Select all

Sub GuessedAndWildcards()  '   https://eileenslounge.com/viewtopic.php?p=282392#p282392
Rem Guessed Offering applied to the Original Test Example
11   If "cfgh!!#v" Like "*[abcd]*" Then Debug.Print True ' True
12   If "abcd!!#v" Like "*[cfgh!!#v]*" Then Debug.Print True ' True
21   If "efgh!!#v" Like "*[abcd]*" Then Debug.Print True ' ____ not true
22   If "abcd" Like "*[efgh!!#v]*" Then Debug.Print True ' ____ not true

Rem For using as literal characters the wildcards use by the VBA  Like   operator to replace certain strings or characters
31   If "efg*h!!#v" Like "*[ab[*]cd]*" Then Debug.Print True ' ____ not true ( doesn't work )
32   If "ab*cd" Like "*[efg[*]h!!#v]*" Then Debug.Print True ' ____ not true ( doesn't work)
41   If "efg*h!!#v" Like "*[ab*cd]*" Then Debug.Print True ' True  ( works)
42   If "ab*cd" Like "*[efg*h!!#v]*" Then Debug.Print True ' True  ( works)
End Sub
_._____

If I understand correctly, Guessed’s offering is pseudo like
If s1 Like "*[" & s2 & "]*" Then Let Geussed = True
If I understand correctly what’s going on there, the left hand side gets attempted to match to any character combination that includes any single character inside the [ ] - That is exactly what we want, and solves the problem very nicely.
Further, my experiments suggest that within the [ ] on the Right Hand Side of Like you can have anything including all the things used as wildscards. – That sort of ties up with generally what you said
Last edited by Doc.AElstein on 09 Apr 2021, 10:58, edited 6 times in total.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Return True if there are any common letters between two strings

Post by Doc.AElstein »

Hello Guessed
That Like operator has been on my list of things to get clued up on for some time: it looks like a very useful thing to have in a VBA programmers Tool box. Looking at that link you gave, it does not seem so difficult to understand as other “Wild things, RegEx and Co.”, which always give me a migrate trying to understand. ( That analystcave place looks like generally a good place for some good VBA string function blogs )

I added your like version in a function form for comparison out of interests.
I haven’t tested thoroughly, but an initial look suggests that your offering, when applied to similar test data to that we have considered so far, its similar to the best results, in terms of speed, we have so far.

( Macro in next post, it wont fit in here... )

Alan
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Return True if there are any common letters between two strings

Post by Doc.AElstein »

Test coding for last post

Code: Select all

'    https://eileenslounge.com/viewtopic.php?f=30&t=36382
Option Explicit
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
 Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
 
Function MicroTimer() As Double
Dim cyTicks1 As Currency: Static cyFrequency As Currency
 Let MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec
 Call getTickCount(cyTicks1) ' get ticks
    If cyFrequency Then Let MicroTimer = cyTicks1 / cyFrequency ' calc seconds
End Function

Sub Tests()
Debug.Print "ComonEileen (Alan)"  '  ' For if no duplicates in either word
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

Debug.Print
Debug.Print "ComonEileen2 (Alan)" ' For if there might be duplicates in words
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")


Debug.Print
Debug.Print "CommonH ( Hans )"
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

Debug.Print
Debug.Print "Like  Geussed"
 Let TimIt = MicroTimer
Debug.Print Geussed("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print Geussed("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

Debug.Print
Debug.Print "Like  Geussed2"
 Let TimIt = MicroTimer
Debug.Print Geussed2("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print Geussed2("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

End Sub



' For if no duplicates in either word
Sub Test1()
Debug.Print "ComonEileen (Alan)"
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary
Dim Cnt As Long
    For Cnt = 1 To Len(s1 & s2)
     Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
    Next Cnt
    If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen = True
End Function

' For if there might be duplicates in words
Sub Test2()
Debug.Print
Debug.Print "ComonEileen2 (Alan)"
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen2(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary, Dik1 As Scripting.Dictionary, Dik2 As Scripting.Dictionary
 Set Dik = New Scripting.Dictionary: Set Dik1 = New Scripting.Dictionary: Set Dik2 = New Scripting.Dictionary
Dim Cnt As Long
    For Cnt = 1 To Len(s1)
     Let Dik1(Mid(s1, Cnt, 1)) = "Anything"
    Next Cnt
 Let s1 = Join(Dik1.Keys(), "")
    For Cnt = 1 To Len(s2)
     Let Dik2(Mid(s2, Cnt, 1)) = "Anything"
    Next Cnt
 Let s2 = Join(Dik2.Keys(), "")
    
    For Cnt = 1 To Len(s1 & s2)
     Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
    Next Cnt
    If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen2 = True
End Function

Sub TestHans()
Debug.Print
Debug.Print "CommonH ( Hans )"
Dim TimIt As Double
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")
 Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & "  " & Format(MicroTimer - TimIt, "0.000000000")

End Sub
Function CommonH(s1 As String, s2 As String) As Boolean
    Dim n1 As Long, n2 As Long, i As Long
    n1 = Len(s1)
    n2 = Len(s2)
    If n1 < n2 Then
        For i = 1 To n1
            If InStr(s2, Mid(s1, i, 1)) Then
                CommonH = True
                Exit Function
            End If
        Next i
    Else
        For i = 1 To n2
            If InStr(s1, Mid(s2, i, 1)) Then
                CommonH = True
                Exit Function
            End If
        Next i
    End If
End Function
'
Function Geussed(s1 As String, s2 As String) As Boolean
    If s1 Like "*[" & s2 & "]*" Then Let Geussed = True
End Function
Function Geussed2(s1 As String, s2 As String) As Boolean
    If s2 Like "*[" & s1 & "]*" Then Let Geussed2 = True
End Function
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Return True if there are any common letters between two strings

Post by Doc.AElstein »

Just to clarify how I see the offering from Guessed applied to the original test data we used...

Code: Select all

'   https://eileenslounge.com/viewtopic.php?p=282383#p282383
Sub TestGuessed()
  If "cfgh!!#v" Like "*[abcd]*" Then  '  True
  Debug.Print "Match!"
  End If
  If "efgh!!#v" Like "*[abcd]*" Then  '  False
  Debug.Print "Match!"
  End If
End Sub
Sub TestGuessed2()
  If "abcd" Like "*[cfgh!!#v]*" Then  '  True
  Debug.Print "Match!"
  End If
  If "abcd" Like "*[efgh!!#v]*" Then  '  False
  Debug.Print "Match!"
  End If
End Sub

If I understand correctly, Guessed’s offering is pseudo like
If s1 Like "*[" & s2 & "]*" Then Let Geussed = True
In the above snippet code line, the strings in s1 or s2 can have things like
[ # ] * ?
in them with no modification

If I understand correctly what’s going on there, the left hand side gets attempted to match to any character combination that includes any single character inside the [ ] - That is exactly what we want, and solves the problem very nicely.
Further, my experiments suggest that within the [ ] on the Right Hand Side of Like you can have anything including all the things used as wildscards. – That sort of ties up with generally with what Hans said, but it means, I think, in this case, that we need to make no adjustment to the original text to allow the Geussed offering to work - we don't need to include our wildcard characters which we want to use as literals in enclosing [ ] on the RHS, because we are already in a pair of [ ] on the RHS
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also