|
|
VBA > Function > Get Nth Word
Get the Nth word in a string. Useful if you have a code where different parts have a meaning. You can also use this in a query to get a list of all words used in the values of a field (see More Notes).
|
|
|
Get the Nth word in a string. Useful if you have a code where different parts have a meaning. You can also use this in a query to get a list of all words used in the values of a field (see More Notes).
You can use this function to parse codes and find words.
This VBA can run from Access ... or Excel, Word, PowerPoint, Project, Visio, ... or other Microsoft Office VBA interface. There is nothing in it that requires Access. It is pure VBA!
Set up an error handler that exits the function and returns the default value if there is a problem. Dimension vaiables for the number of words and a string for the word that is found.
Flags affect manipulation of the string before it is separated. If you are writing all words to a table, and don't care which position they are in, then you will want to set Flags to break words in more places. If space is being used as a delimiter, then the string is the Trimmed for leading and trailing spaces, and repeating internal spaces are removed.
The string is then split into words, using space to delimit (unless something else is specified by psDeli), and the Nth word is returned.
The number of words is iWordCount, and is 1 plus the upper bound (UBound) of the array. Array indexing starts at 0, so 1 is subtracted to get the Nth word.
The Nth word is returned.
'*************** Code Start ***************************************************** ' Purpose : Get the Nth Word in a string ' Author : crystal (strive4peace) ' Return : String ' License : below code ' Code List: www.MsAccessGurus.com/code.htm '--------------------------------------------------------------------------------' GetNthWord
'-------------------------------------------------------------------------------- Function GetNthWord( pString As Variant _ , Optional pWordNum As Integer = 1 _ , Optional psDeli As String = " " _ , Optional pBooHasFlags As Integer = 1 _ , Optional pFlagParentheses As String = 1 _ , Optional pFlagComma As Integer = 1 _ , Optional pFlagPeriod As Integer = 1 _ , Optional pFlagDash As Integer = 0 _ ) As String ' s4p 161005, 181207 On Error GoTo proc_err Dim i As Integer _ , iWordCount As Integer _ , sWord As String Dim aWord() As String 'initialize return value GetNthWord = "" If IsNull(pString) Then Exit Function '--------------- Flags If pBooHasFlags <> False Then 'parentheses If pFlagParentheses = 1 Then pString = Replace(pString, "(", " ( ") pString = Replace(pString, ")", " ) ") ElseIf pFlagParentheses = 2 Then pString = Replace(pString, "(", " ") pString = Replace(pString, ")", " ") End If 'comma If pFlagComma = 1 Then pString = Replace(pString, ",", " , ") ElseIf pFlagComma = 2 Then pString = Replace(pString, ",", " ") End If 'period If pFlagPeriod = 1 Then pString = Replace(pString, ".", " . ") ElseIf pFlagPeriod = 2 Then pString = Replace(pString, ".", " ") End If 'dash If pFlagDash = 1 Then pString = Replace(pString, "-", " - ") ElseIf pFlagDash = 2 Then pString = Replace(pString, "-", " ") End If End If '--------------- remove extra spaces If psDeli = " " Then pString = Trim(pString) Do While InStr(pString, " ") > 0 pString = Replace(pString, " ", " ") Loop End If '--------------- parse 'convert string to an array aWord = Split(CStr(pString), psDeli) iWordCount = UBound(aWord) + 1 'array starts at 0 If pWordNum < 1 Or pWordNum > iWordCount Then Exit Function End If '--------------- calculate (array starts at 0) sWord = aWord(pWordNum - 1) '--------------- set return value GetNthWord = sWord Proc_Exit: On Error Resume Next Exit Function Proc_Err: Resume Proc_Exit End Function ' ' LICENSE ' You may freely use and share this code ' provided this license notice and comment lines are not changed; ' code may be modified provided you clearly note your changes. ' You may not sell this code alone, or as part of a collection, ' without my handwritten permission. ' All ownership rights reserved. Use at your own risk. ' ~ crystal (strive4peace) www.MsAccessGurus.com '*************** Code End ******************************************************* '--------------------------------------------------------------------------------' testGetNthWord
'-------------------------------------------------------------------------------- Sub testGetNthWord() '181210 s4p ' test GetNthWord -- write each word to Debug window Dim sString As String _ , sWord As String _ , i As Integer _ , iCountEmpty As Integer sString = "Joe Smith bought a small shed (Shed-01)," _ & " but then changed his mind and decided to exchange it" _ & " for Shed-02 before delivery was made." i = 1 iCountEmpty = 0 Debug.Print "*** " & Now Debug.Print sString Do 'get the next word, delimiter is space (default, ' True = Has Flags -- take defaults to separate () and , sWord = GetNthWord(sString, i, , True) Debug.Print Space(2) & Format(i, "#,#00. ") & sWord If sWord = "" Then iCountEmpty = iCountEmpty + 1 Else iCountEmpty = 0 End If i = i + 1 'loop until it is probably done Loop Until iCountEmpty = 5 MsgBox "press Ctrl-G to open Debug window", , "Done" End Sub
Rather than creating code to run this, you can use this function in the calculated field of a query. You just need a table to make the numbers.
Make a table called Numberz with a Long Integer primary key field called Num. Put as many records in as you think you will need. For this example, we use 20 for the maximum number of words on a line.
If you are using a Numberz table to control number of copies to print, then 3 or 4 records is probably okay. If you are using the Numberz table to make dates, then you'll need at least 31 if you are constructing from parts, and more if you are also using it to create more than a month of days in a range of dates.
We have a table of addresses, called c_Address. We will split Addr1, which is the first address line, and might look something like "123 Main Street".
Make a query using whatever table has the field you want to split into words.
In our example using addresses, perhaps it is desired to isolate Street Names so they can be put into a quick-pick table. The street name is between the number and street type, and may be more than one word.
So lets say you have this SQL:
SELECT MyTable.Addr1 AS MyString
, Numberz.Num, GetNthWord([Addr1]
,[num]) AS Wrd, MyTable.AdrID
FROM c_Address AS MyTable, Numberz
WHERE ( ( MyTable.Addr1 Is Not Null)
AND ( Numberz.Num <=10)
AND ( GetNthWord([Addr1],[num] ) <>"") )
;
Here are the results, using our example:
Then make another query, on top pf that, to group and count the words:
SELECT qParse.Wrd
, Count(qParse.Wrd) AS CountOfWrd
FROM w_qParse2Words_Add1 AS qParse
GROUP BY qParse.Wrd
;
Scrolling down to somewhere in the S's, here are the results:
If you are parsing to separate address into its discreet types, then you would also have a StreetTypes table to recognize common types like Street, Avenue, Boulevard, and their abbreviations.
A cartesian query does not specify how tables are linked so it gets every combination possible ... so you will have a resulting record set with many! more rows than you started with.
Unlike the text VBA code, that checks for, like 5, blank lines in a row to stop; in a query, you can't do this -- so make optimize to make the number of words to look for equal to the maximum you think you will have, plus a few more.
Don't let the apparent complexity of this scare you off from trying it! Spend an hour -- you'll get it!
When prompted for a name, use mod_GetNthWord or something else logical that is different than any procedure name. Once it compiles without any issues, you are ready to run.
* if you have problems, email me. I will try to help and then expand these instructions.
Once you have saved this code in a module, to run this, modify testGetNthWord -- then rename it and run it. HOWEVER, you will probably find the query example more useful -- it takes a little longer to set up because you have to create a Numberz table too -- but so worth it!
Sample database has: