Need VBA (For Loop) to find a **repeated** 3-character string in a record... if so, mark record TRUE

[skydivetom]

Micron -- awesome... comments are always, always helpful!!

[Welshgasman]

I'm intrigued by that. Can you post an example?

Ok, there is an issue with it if it is the first word, but I am just trying to lay the groundwork here?

Sub TestSplit()
Dim strSentence As String, strSub As String, strSplit() As String
Dim i As Integer
strSentence = " The quick brown fox jumped over the lazy dog, as the cat cried"
strSub = "the"
strSplit = Split(strSentence, strSub)
For i = 0 To UBound(strSplit)
    Debug.Print strSplit(i)
Next
For i = 0 To UBound(strSplit)
    Debug.Print strSub & strSplit(i)
Next

End Sub

Output
 
 quick brown fox jumped over 
 lazy dog, as 
 cat cried
the 
the quick brown fox jumped over 
the lazy dog, as 
the cat cried

[Micron]

Using Vlad's db (thank you, Vlad) and a modified vcGroupChrTwice function. Because the function will run multiple times, a string variable is needed in the module declaration section or else the string will be reset to "" on each function call. So add

Dim strMVF As String
beneath
Public Const Blank As String = " "

I didn't see a function in the list that looked like it would verify that a string contained only alpha and no spaces so I added this:

Function IsAlphaOnly(strIn As String) As Boolean
Dim n As Integer

For n = 1 To Len(strIn)
   Select Case Asc(Mid(strIn, n, 1))
      Case 65 To 90
         IsAlphaOnly = True
      Case 97 To 122
         IsAlphaOnly = True
      Case Else
         IsAlphaOnly = False
         Exit For
   End Select
Next
      
End Function

Vlad's function now looks like this

Public Function vcGroupChrTwice(strSentence As String, iCharacters As Integer) As String
Dim sToCheck As String
Dim i As Integer

strMVF = "" 'reset module level variable
If Len(strSentence) <= iCharacters Then Exit Function

For i = 1 To Len(strSentence) - (iCharacters - 1)
    sToCheck = Mid(strSentence, i, iCharacters) 
    If IsAlphaOnly(sToCheck) Then 'check for only a-z and A-Z
       If InStr(i + iCharacters, strSentence, sToCheck) > 0 Then 'if the substring is found in the string ...
         If InStr(strMVF, sToCheck) = 0 Then strMVF = strMVF & sToCheck & ", " 'add it, but not if it's already there (<> 0)
      End If
   End If
Next i

If Len(strMVF) & vbNullString = 0 Then
   Exit Function
Else
   strMVF = Left(strMVF, Len(strMVF) - 2)
End If

vcGroupChrTwice = strMVF

End Function

End Function

I chose my Instr approach rather than call another procedure that loops over the search string x times since I found it easier. You could try the other way I guess.

[skydivetom]

Hmh... totally different approach. Not familiar w/ the setup yet.

Forgive me I'm now somewhat biased towards Vlad's setup (given that I know it's working)... but requires slight tweaking. All that said, I'm open to a new method if the desired outcome is achieved.

[skydivetom]

Micron -- do I declare strMVF as "string".

    Dim strMVF As String

If so, when I execute the query, I only output the sentence... all else is blank. Would you be willing to post the DB version? Maybe I missed something obvious?

[Micron]

The only difference is not passing the substring to another UDF when you can achieve the same with a built in function? I don't get your comment. I started with his procedure, added the functionality you requested (minus the count, which you agreed was not helpful) and the results seem to achieve your latest modified goal but somehow it's not suitable even though it found instances you overlooked before?
Going for now.

EDIT

Dim strMVF As String
beneath
Public Const Blank As String = " "

[Micron]

as requested

Search Criteria v03Vlad.zip

[Gicu]

Here you are Tom.
Cheers,
Vlad

[orange]

Here is another function. It doesn't use vlad's routines. It rejects spaces or "." in a substring.
It does handle numeric substrings.

' ----------------------------------------------------------------
' Procedure Name: breakOutSubstrings
' Purpose: to check whether or not there exists at least X number of occurrences of a string within a larger string
' Procedure Kind: Function
' Procedure Access: Public
' Parameter str (String): String to be reviwed
' Parameter SubSize (Integer): Size of substrings
' Parameter nOcc (Integer): minimum number of occurrences to return
' Return Type: Variant
' Returns:    if found- a list of substrings and counts
'           if NOT found-a message - "No such substrings with size "
' Author: Jack
' Date: 09-Mar-21
' ----------------------------------------------------------------
Function breakOutSubstrings(str As String, SubSize As Integer, nOcc As Integer) As Variant
10        On Error GoTo breakOutSubstrings_Error
          Dim i As Integer, j As Integer, k As Integer
          Dim s As String, h As String, Ignore As String
          Dim mVar As Variant
          Dim cnt As Integer
          Dim v() As String
20        Ignore = " "
30        s = str

          'remove  elements containing spaces or .
            
40        For k = 1 To Len(s)
50            If Not (Mid(s, k, SubSize) Like "* *") And _
                  Not (Mid(s, k, SubSize) Like "*.*") Then
60                h = h & Mid(s, k, SubSize) & "|"
70            End If
80        Next k
          'Debug.Print h  'for testing/debugging
90        v = Split(h, "|")
          'Debug.Print "There are " & UBound(v) & "  elements in the string" 'for testing/debugging
100       h = ""  'initialize h (hold value)
          
110       For j = 0 To UBound(v)
120           h = v(j)
130           If InStr(Ignore, v(j)) > 0 Then GoTo AlreadyChecked
140           cnt = 1    'hold this element and check remaining
150           For i = j + 1 To UBound(v)
160               If v(i) = h Then
170                   If InStr(Ignore, v(i)) = 0 Then  'has this already been counted?
180                       cnt = cnt + 1
190                   End If
200               End If
210           Next i
220           If cnt >= nOcc Then
                  ' Debug.Print h & "   count: " & cnt       'for testing/debugging
230               mVar = mVar & h & "(" & cnt & "), "
240               Ignore = Ignore & h
250           End If
         
AlreadyChecked:
260       Next j
270       If mVar = "" Then
280           breakOutSubstrings = "No such substrings with size " & SubSize & " and >= " & nOcc & " occurrences"
290       Else
300           breakOutSubstrings = Mid(mVar, 1, Len(mVar) - 2)
310     End If
          
320       On Error GoTo 0
breakOutSubstrings_Exit:
330       Exit Function

breakOutSubstrings_Error:
340       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure breakOutSubstrings, line " & Erl & "."
350       GoTo breakOutSubstrings_Exit
End Function

and a test routine
Test1:

Sub xxx()
Dim s As String
s = "The lion and the lioness are busy with their cubs learning cubic roots and the business of dandelions"
Debug.Print breakOutSubstrings(s, 2, 3)
End Sub

result: Th(5), he(4), li(3), io(3), on(3), an(3), nd(3)

Test2:

Sub xxx()
Dim s As String
s = "The lion and the lioness are busy with their cubs learning cubic roots and the business of dandelions"
Debug.Print breakOutSubstrings(s, 4, 4)
End Sub

Result: No such substrings with size 4 and >= 4 occurrences

Test3:

Sub xxx()
Dim s As String
s = "The lion and the lioness are busy with their cubs learning cubic roots and the business of dandelions"
Debug.Print breakOutSubstrings(s, 4, 2)
End Sub

Result: lion(3), ness(2)

Test4:

Sub xxx()
Dim s As String
s = "The lion and the lioness are busy with their 125 cubs learning cubic roots  of 125 and the business of dandelions"
Debug.Print breakOutSubstrings(s, 3, 2)
End Sub

Result: The(4), lio(3), ion(3), and(3), nes(2), ess(2), bus(2), 125(2), cub(2)

[isladogs]

"The lion and the lioness are busy with their 125 cubs learning cubic roots of 125 and the business of dandelions"

No comment!

[orange]

Yes, test data really challenges the imagination!!!
Just to show numeric substring.

[skydivetom]

orange... how do I call it from a query?

Btw, I got a kick out of the lions sentence (it's about time they learn about cubic roots and dandelions).

[skydivetom]

Micron -- thank you... that's a nice solution to the question.

Could you please provide some additional info on the IsAlphaOnly function? What is the purpose for the '65-90' and '97-122' case statements?

[Gicu]

Here is an updated version that ignores "." and spaces " ". Very easy to implement and modify using the helper functions from the module.

Cheers,
Vlad

[orange]

Tom,

Here is a query sql that shows how the function is called. Pay no attention to the text - it was part of a post about correcting the gender pronouns.

SELECT StudentGenderSample.StudName
, StudentGenderSample.StudComment AS s
, breakOutSubstrings([s],6,2) AS Subs
FROM StudentGenderSample;

And here is result