Micron -- awesome... comments are always, always helpful!!
Micron -- awesome... comments are always, always helpful!!
Ok, there is an issue with it if it is the first word, but I am just trying to lay the groundwork here?
Code: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
Please use # icon on toolbar when posting code snippets.
Cross Posting: https://www.excelguru.ca/content.php?184
Debugging Access: https://www.youtube.com/results?sear...bug+access+vba
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:
Vlad's function now looks like thisCode: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
End FunctionCode: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
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.
The more we hear silence, the more we begin to think about our value in this universe.
Paraphrase of Professor Brian Cox.
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.
Micron -- do I declare 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?Code:Dim strMVF As String
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 = " "
The more we hear silence, the more we begin to think about our value in this universe.
Paraphrase of Professor Brian Cox.
as requested
Search Criteria v03Vlad.zip
The more we hear silence, the more we begin to think about our value in this universe.
Paraphrase of Professor Brian Cox.
Here you are Tom.
Cheers,
Vlad
Here is another function. It doesn't use vlad's routines. It rejects spaces or "." in a substring.
It does handle numeric substrings.
and a test routineCode:' ---------------------------------------------------------------- ' 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
Test1:
result: Th(5), he(4), li(3), io(3), on(3), an(3), nd(3)Code: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
Test2:
Result: No such substrings with size 4 and >= 4 occurrencesCode: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
Test3:
Result: lion(3), ness(2)Code: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
Test4:
Result: The(4), lio(3), ion(3), and(3), nes(2), ess(2), bus(2), 125(2), cub(2)Code: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
Last edited by orange; 03-09-2021 at 03:20 PM. Reason: spelling and code tags
No comment!"The lion and the lioness are busy with their 125 cubs learning cubic roots of 125 and the business of dandelions"
Yes, test data really challenges the imagination!!!
Just to show numeric substring.
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).
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?
Here is an updated version that ignores "." and spaces " ". Very easy to implement and modify using the helper functions from the module.
Cheers,
Vlad
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.
And here is resultCode:SELECT StudentGenderSample.StudName , StudentGenderSample.StudComment AS s , breakOutSubstrings([s],6,2) AS Subs FROM StudentGenderSample;