BOOLEAN VBA FUNCTION !!!

[jay dean]

Hi -

I'm looking for a Boolean VBA function, MyFun, that takes in 2 input
strings, String1 and String2, like MyFun(String1,String2). Here are the
specs:

(1) If ALL the tokens in String2 are also tokens of String1, then MyFun
will output to "True", otherwise, it should return "False"

(2) Also, if either String1 or String2 is empty "", then MyFun will
return "False"

(3) The tokens in both input strings are delimited by "," except when
there is only one token contained in any input.

Example:
MyFun("YH,L,GT,W,B,Q","B,GT,YH") should return "True"

MyFun("H,C,KK,V","") should return "False"

MyFun("AY,DC,GJ,U","AY,U,Z") should return "False"

I would appreciate any assistance!
Thank you.
Jay Dean

 

[Per Jessen]

Hi Jay Dean

This should do what you are looking for:

Public Function MyFun(String1 As String, String2 As String) As Boolean
Dim arr1 As Variant
Dim arr2 As Variant
If String1 = "" Or String2 = "" Then
Exit Function
End If
If InStr(1, String1, ",") Then
arr1 = Split(String1, ",")
Else
ReDim arr1(0)
arr1(0) = String1
End If

If InStr(1, String2, ",") Then
arr2 = Split(String2, ",")
Else
ReDim arr2(0)
arr2(0) = String2
End If

For c = LBound(arr2) To UBound(arr2)
For r = LBound(arr1) To UBound(arr1)
If arr2(c) = arr1(r) Then
Token = Token + 1
Exit For
End If
Next
Next
If Token = UBound(arr2) + 1 Then
MyFun = True
End If
End Function

Regards,
Per

 

[keiji kounoike]

Try this one

Function myfunc(ByVal s1 As String, ByVal s2 As String) As Boolean
Dim s1a, s2a, dummy

s1a = Split(s1, ",")
s2a = Split(s2, ",")
On Error GoTo ex:
For i = 0 To Application.Max(0, UBound(s2a))
dummy = WorksheetFunction.Match(s2a(i), s1a, 0)
Next
myfunc = True
Exit Function
ex:
myfunc = False
End Function

Keiji

 

[Rick Rothstein]

Give this function a try...

Function MyFun(S1 As String, S2 As String) As Boolean
Dim X As Long, Cnt As Long
Dim Tokens() As String
If Len(S2) Then
Tokens = Split(S2, ",")
For X = 0 To UBound(Tokens)
If InStr("," & S1 & ",", "," & Tokens(X) & ",") Then Cnt = Cnt + 1
Next
If Cnt = UBound(Tokens) + 1 Then MyFun = True
End If
End Function

 

[Ron Rosenfeld]

Hi -

I'm looking for a Boolean VBA function, MyFun, that takes in 2 input
strings, String1 and String2, like MyFun(String1,String2). Here are the
specs:

(1) If ALL the tokens in String2 are also tokens of String1, then MyFun
will output to "True", otherwise, it should return "False"

(2) Also, if either String1 or String2 is empty "", then MyFun will
return "False"

(3) The tokens in both input strings are delimited by "," except when
there is only one token contained in any input.

Example:
MyFun("YH,L,GT,W,B,Q","B,GT,YH") should return "True"

MyFun("H,C,KK,V","") should return "False"

MyFun("AY,DC,GJ,U","AY,U,Z") should return "False"

I would appreciate any assistance!
Thank you.
Jay Dean

Try this:

==============================
Option Explicit
Function MyFun(S1 As String, S2 As String) As Boolean
Dim sTokens2() As String
Dim i As Long

sTokens2 = Split(S2, ",")

For i = 0 To UBound(sTokens2)
If InStr(S1, sTokens2(i)) = 0 Then Exit For
Next i
If i > 0 And i = UBound(sTokens2) + 1 Then MyFun = True
End Function
================================
--ron

 

[Rick Rothstein]

I'm looking for a Boolean VBA function, MyFun, that takes in 2 input

Try this:

==============================
Option Explicit
Function MyFun(S1 As String, S2 As String) As Boolean
Dim sTokens2() As String
Dim i As Long

sTokens2 = Split(S2, ",")

For i = 0 To UBound(sTokens2)
If InStr(S1, sTokens2(i)) = 0 Then Exit For
Next i
If i > 0 And i = UBound(sTokens2) + 1 Then MyFun = True
End Function
================================

You can't test with InStr directly like that because it will return false
positives for short included string in S2. For example...

MsgBox MyFun("AA,BB,CC", "A,B")

will display True even though A and B do not appear, as is, in "AA,BB,CC".
That is why in the function I posted I concatenated the delimiter onto each
element of the second argument's string value and put a delimiter on each
side of the first argument's string value... doing this insures unique
matches. I do like your idea of testing for failure inside the loop
(although I would probably just Exit Function at that point) and then using
the For..Next loop's index for your logical test as opposed to the "extra"
counter variable I used. This is the line of I would use inside your loop to
account for the above comments...

If InStr("," & S1 & ",", "," & sTokens2(i) & ",") = 0 Then Exit Function

 

[jay dean]

Thanks Rick, Per Jessen, Keiji, and Ron.
A few comments:

Keiji, your code works just as the others but it doesn't seem to do a
binary compare. For example, using your code: MyFun("GG,TY,D","gg,D")
will evaluate to "True" even though the token "GG" <> "gg".

I think agree with Rick's comments on Ron's code. In effect, it works
like the Find() function. It doesn't look for exact matches explicitly,
but also includes 'hits' that match partially.
Rick, is there a way to modify your code so that it ignores spaces as
the Trim() function will do? Example: Right now, using your code,
MyFun("YH,L,GT,W,B,Q", " B")
or MyFun("YH,L,GT,W,B,Q", " B,W ") produces "False" because of the
spaces in the tokens, even though "B" and "W" are elements of the first
input. Is there a way to have this ignore the spaces and ouput to "True"
as long as all the characters themselves match regardless of any spaces
in the tokens?

Thanks
Jay

 

[Rick Rothstein]

Using the structure Ron posted (along with my modified line of code), I just
use the Replace function on *each* argument's string values to remove any
and all spaces from both of them...

Function MyFun(S1 As String, S2 As String) As Boolean
Dim i As Long
Dim sTokens2() As String
sTokens2 = Split(Replace(S2, " ", ""), ",")
For i = 0 To UBound(sTokens2)
If InStr("," & S1 & ",", "," & Replace(sTokens2(i), _
" ", "") & ",") = 0 Then Exit Function
Next i
If i > 0 And i = UBound(sTokens2) + 1 Then MyFun = True
End Function

 

[Ron Rosenfeld]

You can't test with InStr directly like that because it will return false
positives for short included string in S2. For example...

MsgBox MyFun("AA,BB,CC", "A,B")

will display True even though A and B do not appear, as is, in "AA,BB,CC".

Good point.

Well, here's a regex solution that I think works properly. Jay wrote in
another message that he wanted to also filter out spaces, so I added some code
to do that.

============================
Function MyFun(S1 As String, S2 As String) As Boolean
Dim re As Object, mc As Object
Dim lMatches As Long, lNumTokens As Long
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "\b(" & _
Replace(Replace(S2, " ", ""), ",", "|") & ")\b"
lNumTokens = Len(S2) - Len(Replace(S2, ",", "")) + 1
Set mc = re.Execute(S1)
If mc.Count = lNumTokens Then MyFun = True
End Function
==============================

--ron

 

[keiji kounoike]

Thanks for your comment. I used match function that does not distinguish
between uppercase and lowercase letters. On the other hand, Instr
function that Rick and Ron used has options for a binary comparison or a
binary comparison.

Keiji

 

[keiji kounoike]

Hi Rick
I'm a little bit interested in how you realized Jay's tokens are case
sensitive. By the way, you said you removed all spaces from *each*
argument's string values. but your code below seems to remove all spaces
from the second argument twice and I would like to apply Replace to S1
before for loop. I think this one is simple and looks smart, though it's
not my taste not to explicitly set a return value false assuming default
value.

Keiji

 

[Rick Rothstein]

*** Code Correction ***

In a parallel posting, Keiji observed a problem with the function I posted.
Here is a modified function that fixes the problem.

Function MyFun(S1 As String, S2 As String) As Boolean
Dim i As Long, S1FixedUp As String, sTokens2() As String
S1FixedUp = "," & Replace(S1, " ", "") & ","
sTokens2 = Split(Replace(S2, " ", ""), ",")
For i = 0 To UBound(sTokens2)
If InStr(S1FixedUp, "," & sTokens2(i) & ",") = 0 Then Exit Function
Next
If i > 0 And i = UBound(sTokens2) + 1 Then MyFun = True
End Function

 

[Rick Rothstein]

Good catch on the problem with my coding! You were absolutely correct about
the way I handled the spacing. I do recall trying to make some last minute
changes and it looks like I picked the wrong version of the function to go
with in the end. For archive continuity, I just posted a corrected function
as a response to the message where I posted the incorrect code in. Thanks
for catching that... I really appreciate it!

As for the case sensitivity... I had forgotten to add a sentence to my first
posted code saying that if the OP wanted case insensitivity, the InStr
function call had optional parameters that would allow it to do that.

 

[jay dean]

Rick, Keiji, Ron, and Per -

I would like to 'ramp' MyFun up one dimension if possible. I'd like to
build on MyFun another Boolean function, MyFun2 that takes in two 1D
String arrays, String1() and String2(), like MyFun2(String1(),
String2()) as Boolean. Here are the specs:

(1)MyFun2 has same specs as MyFun, except that MyFun2 takes in two 1D
String arrays, instead of two Strings.

(2)If ALL the indexes of String2() are also indexes of String1(), then
MyFun2 will return "True", otherwise, it returns "False"

Example:

String1=("AY,F,VV,M","K,OP,CG,FF","E,Q,S,2H")
String2=("S,E","Q,2H","M,AY","VV,F")
MyFun2(String1(),String2()) should return "True"

String1=("BB,U,W","Q,AA,Z","XX,T,SS")
String2=("U,W,BB","W,AA,U","BB,SS,XX")
MyFun2(String1(),String2()) should return "False"

Thanks
Jay Dean

 

[Rick Rothstein]

This function will do the job of both functions (the original MyFun and the
MyFun2 that you just asked for); that is, you can pass it any combination of
strings or string arrays for its two arguments and it will validate them as
you requested...

Function MyFunBoth(S1 As Variant, S2 As Variant) As Boolean
Dim Counter As Long
Dim V1 As Variant, V2 As Variant
Dim S1FixedUp As String, STokens2() As String
Dim S1working() As String, S2working() As String
If VarType(S1) = vbArray + vbString Then
S1working = Split(Join(S1))
Else
S1working = Split(S1)
End If
If VarType(S2) = vbArray + vbString Then
S2working = Split(Join(S2))
Else
S2working = Split(S2)
End If
For Each V1 In S1working
For Each V2 In S2working

S1FixedUp = "," & Replace(V1, " ", "") & ","
STokens2 = Split(Replace(V2, " ", ""), ",")
For i = 0 To UBound(STokens2)
If InStr(S1FixedUp, "," & STokens2(i) & ",") = 0 Then Exit For
Next
If i > 0 And i = UBound(STokens2) + 1 Then Counter = Counter + 1
Next
Next
If Counter = UBound(S2working) + 1 Then MyFunBoth = True
End Function

 

[keiji kounoike]

I don't know whether or not this one is what you want, because i don't
know if i understand your criteria correctly.
MyFunc below can deal arguments with both array and string. I used
Rick's MyFun in MyFunc because it was easy to write the code. Of course,
It's better to write equivalent code to Myfunc in MyFunc for the time of
processing.

Function MyFunc(s1, s2) As Boolean
Dim i As Long, j As Long
Dim tmp As Boolean
If (VarType(s1) = vbArray + vbVariant Or _
VarType(s1) = vbArray + vbString) And _
(VarType(s2) = vbArray + vbVariant Or _
VarType(s2) = vbArray + vbString) Then
For i = 0 To UBound(s2)
For j = 0 To UBound(s1)
If MyFun(s1(j), s2(i)) Then
tmp = True
Exit For
End If
Next
If j > UBound(s2) Then
tmp = False
Exit For
End If
Next
ElseIf (VarType(s1) <> vbArray + vbVariant And _
VarType(s1) <> vbArray + vbString) Or _
(VarType(s2) <> vbArray + vbVariant And _
VarType(s2) <> vbArray + vbString) Then
tmp = False
Else
tmp = MyFun(s1, s2)
End If
MyFunc = tmp
End Function

'Below is the Rick's code

Function MyFun(ByVal s1 As String, ByVal s2 As String) As Boolean
Dim i As Long, S1FixedUp As String, sTokens2() As String
S1FixedUp = "," & Replace(s1, " ", "") & ","
sTokens2 = Split(Replace(s2, " ", ""), ",")
For i = 0 To UBound(sTokens2)
If InStr(S1FixedUp, "," & sTokens2(i) & ",") = 0 Then Exit Function
Next
If i > 0 And i = UBound(sTokens2) + 1 Then MyFun = True
End Function

Keiji

 

[Ron Rosenfeld]

Rick, Keiji, Ron, and Per -

I would like to 'ramp' MyFun up one dimension if possible. I'd like to
build on MyFun another Boolean function, MyFun2 that takes in two 1D
String arrays, String1() and String2(), like MyFun2(String1(),
String2()) as Boolean. Here are the specs:

(1)MyFun2 has same specs as MyFun, except that MyFun2 takes in two 1D
String arrays, instead of two Strings.

(2)If ALL the indexes of String2() are also indexes of String1(), then
MyFun2 will return "True", otherwise, it returns "False"

Example:

String1=("AY,F,VV,M","K,OP,CG,FF","E,Q,S,2H")
String2=("S,E","Q,2H","M,AY","VV,F")
MyFun2(String1(),String2()) should return "True"

String1=("BB,U,W","Q,AA,Z","XX,T,SS")
String2=("U,W,BB","W,AA,U","BB,SS,XX")
MyFun2(String1(),String2()) should return "False"

Thanks
Jay Dean

In my regex solution, I think it only requires a minor modification to test the
strings and see if they are arrays. If they are arrays, then combine them into
strings.

MyFun (will work on either strings, or arrays):

================================
Option Explicit
Function MyFun(S1, S2) As Boolean
Dim re As Object, mc As Object
Dim lMatches As Long, lNumTokens As Long

If IsArray(S1) Then S1 = Join(S1, ",")
If IsArray(S2) Then S2 = Join(S2, ",")

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "\b(" & _
Replace(Replace(S2, " ", ""), ",", "|") & ")\b"
lNumTokens = Len(S2) - Len(Replace(S2, ",", "")) + 1
Set mc = re.Execute(S1)
If mc.Count = lNumTokens Then MyFun = True
End Function
================================
--ron