word number of specific word in string

[supmktg]

I have a mailing list in which the name field may contain 2 names such as:

Mr. John Smith and Ms. Mary Jones

This should be split to 2 fields on the word " and ":

Name1 = Mr. John Smith
Name2 = Ms. Mary Jones

The name field may also contain:

Mr. and Mrs. James Smith

This should not be split on the word " and " but should end up as:

Name1 = Mr. and Mrs. James Smith

I would like to determine the word number (if it exists) of the word " and " in the string so I can split the field if the " and " is word number 3 or higher.

Something like:

Function MaxWordNum(strNameFld as string, strWord as string)
'find the word number of the last occurance of strWord within strNameFld
'then split the string on MaxWordNum if MaxWordNum > 2
End Function

Any help would be greatly appreciated!

Thanks,
Sup

 

[pbaldy]

The InStr() function can be used with the Mid() function to pull out your data:

?instr(1,"Mr. John Smith and Ms. Mary Jones", " and ")
15
?instr(1,"Mr. and Mrs. James Smith", " and ")
4

 

[supmktg]

Hi Paul,

I started out using the instr function to determine if the was an " and " in the field. Then I used the Split function to separate the 2 names.

The issue is that sometimes " and " is part of the title as in:
Senator and Mrs. Jack Jones
in which case I don't want to split the string.

I'm trying to determine the word number in the string. If " and " is greater than word number 2, then I will separate the 2 names, if not I will leave the string alone.

Thanks,
Sup

 

[pbaldy]

It seems like you could also use InStr() to find the first space. If that matches what it returns for " and ", you don't want to split that record.

 

[smig]

I guess you'll have to count the number of spaces + 1 to get the number of words

function WordCount(testString as string) As Long
 
dim i as long
dim x as long
 
x = 0
 
testString  = Trim(testString)
 
if testString <> "" then 
  for i = 1 to Len(TestString)
    if Mid(TestString, i) = " " Then x = x + 1
  next i
 
  WordCount = x + 1
else
  WordCount  = 0
end if
 
end function

 

[pbaldy]

The length of the string less the length of the string without spaces should yield the same result. No loop required.

 

[smig]

The length of the string less the length of the string without spaces should yield the same result. No loop required.

Nice idea

How will you test for the length with no spaces ? using Replace() to change " " into "" ?
I guess the Replace() will also use a kind of loop internaly.

 

[nanscombe]

What about thinking about the size of the 'Mr' clause?

'Mr J Doe' for instance would be about smallest possible, 8 characters.

If the word ' and ' (I'm using leading and trailing spaces in case of a name like 'Anderson') was found between characters 1 (possibly 2 in reality 'J and P Smith') and 8 it would likely be the 'Mr and Mrs' type.

Public Sub splitCouples(ByVal CoupleString As String, ByRef Name1 As String, ByRef Name2 As String)
Dim pl1 As Long

' Usage - splitCouples "Mr. and Mrs. John Smith", Name1, Name2
'
' CoupleString - The source
' Name1 - This is a variable, passed by reference, into the subroutine which will hold the value of Name1
' Name2 - This is a variable, passed by reference, into the subroutine which will hold the value of Name2



pl1 = InStr(LCase$(CoupleString), " and ") ' lcase$() gets over and problems with capitalisation.
' I am assuming that the shortest first name would be "Mr J Doe" i.e 8 characters long
' I am looking for " and " rather than "and" in case the name is like [And]erson or C[and]y

Select Case pl1
Case 0
' If " and " is not found assume that it is not a couple
  Name1 = Trim$(CoupleString)
  Name2 = ""

Case 1 To 8
' If " and " is found in the first 8 characters assume that the form is "Mr. and Mrs. John Smith"
  Name1 = Trim$(CoupleString)
  Name2 = ""

Case Else
' For all other cases assume that the form is "Mr. John Smith and Ms. Mary Jones"
  Name1 = Trim$(Mid$(CoupleString, 1, pl1 - 1))
  Name2 = Trim$(Mid$(CoupleString, pl1 + 5))

End Select

End Sub

If this were used as splitCouples "Mr. and Mrs. John Smith", Person1, Person2 then the variables Person1 and Person2 would end up holding the results.

I have tried it with the forms
splitCouples "Mr. and Mrs. John Smith", Name1, Name2
splitCouples "Mr. John Smith and Ms. Mary Jones", Name1, Name2
splitCouples "Mr. John Smith", Name1, Name2
splitCouples "J and P Smith", Name1, Name2
splitCouples "Senator and Mrs. Joe Manchin", Name1, Name2

I hope this is useful

ETA:

If "Case 1 To 8" was changed to "Case 1 to 10" it would cope with 'President and Mrs Barack Obama' as well.

 

[vbaInet]

To be honest, you should be looking to restructure the way you save the name into your table. If you're needing to do this then that field isn't properly structured. You should have three fields - Title, FirstName and Surname.

As a temporary fix, here's the shorter version:

Public Function SplitCouples(strName As String, ByRef strName1 As String, strName2 As String) As Variant
    Dim intPos As Integer
    
    intPos = InStr(1, strName, " and ")
    
    If Mid(strName, InStr(1, strName, " "), 5) = " and " Then
        strName1 = strName
        strName2 = vbNullString
    Else
        strName1 = Mid(strName, 1, intPos - 1)
        strName2 = Mid(strName, intPos + 5)
    End If
End Function

I suspect that even if you use one of the methods given, there may be inconsistencies with the result. For example, if you had extra spaces, repeated fields ... etc.

 

[supmktg]

Thanks to everyone for your help with this.

I'm using this function to manipulate/standardize mailing name data from many different sources for entry into a new table. I was stumped on this one, but your help got me where I needed to go. Here's the function that I got to work:

Public Function SplitCouples(strName As String) As String
    Dim intPos2 As Integer 'position of 2nd word in name fld (1st space)
    Dim intPosAnd As Integer 'position of last ' and ' in name fld
    Dim strName1 As String
    Dim strName2 As String

    intPos2 = InStr(1, strName, " ")
    intPosAnd = InStrRev(strName, " and ")
    
    If intPosAnd > intPos2 Then ' if the last ' and ' begins after the 2nd word
        strName1 = Mid(strName, 1, intPosAnd - 1) 'string left of ' and '
        strName2 = Mid(strName, intPosAnd + 5) 'string right of ' and '
        
        SplitCouples = strName1 & "|" & strName2 'function returns a string that can be split later for entry into table
    Else
        SplitCouples = strName 'function leaves original string alone for entry into table
                
    End If

End Function

Thank you all very much,
Sup

 

[vbaInet]

Glad to hear that you got it working.

However, there was no problem with the code. You just needed to give it two variables (i.e. I was using nanscombe's method ).

It's also worth noting that there are cases where your function will yield different results to the one I wrote. Although, the chances of it happening is very slim anyway.

Good luck with the rest of your project!