proper-type function when II, IV on end of name

[dgr7]

hello,
I've in the past used the Proper() function to convert all cap names like
JOHN SMITH JR
to
John Smith Jr
but I've ran into a problem in that the Proper() function also changes
BOB SMITH IV
into
Bob Smith Iv.

What function or VBA code could I use that when the name has IV or II or III after it to leave those letters in CAPS and change the rest of the name to Proper?
thanks in advance,
david

 

[jakeb3482]

you could maybe make an IF statement that says if string equals IV or III or II then keep those capital...

 

[dgr7]

could you help me with what the IF statement syntax...
My thoughts on this is I think it'd have to do something like

IF
right two characters of string are II or III or IV
then
Concatenate(Proper(the characters up to the II, etc.) and a space and the right two characters)
else
Proper the whole string

how would I write that where Excel could use it?

 

[jakeb3482]

i gotta finish some stuff up right now. ill try to help you during my lunch break unless someone gets to it before me.

 

[dgr7]

Can anyone help me with this??

thanks.

 

[Andrew Poulsom]

Try eg:

=IF(RIGHT(A1,3)="III",PROPER(SUBSTITUTE(A1,"III",""))&"III",IF(OR(RIGHT(A1,2)="II",RIGHT(A1,2)="IV"),PROPER(LEFT(A1,LEN(A1)-2))&RIGHT(A1,2)))

 

[dcardno]

Are you stipulating a limit on how large the numeric suffix can be? For names up to the fifth generation (John Jones V) you can test the last two characters (although II and III) presents a problem. If you are getting up to larger values (Emperor Maximillian XXVIII) you have to have more conditionals...

Thinking out loud, I would test the last character - if it is anything other than I or V (or maybe X - see above), you aren't dealing with a numeric suffix - the function should just run the string through PROPER() and return the result. If you DO get one of those letters, you have to test against a name like Charles Simonyi by examining the second-last character - again, if it is NOT I, V, X or "space" (I can't think of any Ls, Cs or especially Ds or Ms!) then you are dealing with a regular name - apply the PROPER() function.

If you are dealing with a numeric suffix, you have to test to get the whole suffix - if the second-last character was a "space" then you know that the suffix is I (probably only applicable to royalty), V or X. Apply UPPER to the left-part of the string to LEN()-1, and append the numeric suffix (probabaly after applying UPPER().

If the second-last character is not a "space" then you have to work your way back, character by character to find the space. There are quick formulas for finding the last space in a string - you could either use those or just go step-by-step. I prefer the step by step method, although it is probably slower, since it allows you to test for unexpected values, like -say- F, which would indicate a different error, like a missing space or something. Once you find your numeric suffix (actually, the location of the space that seperates it from the name) you would apply PROPER() to the left-part to that seperator and UPPER to the right-part from the seperator, and then append them.

If you need a hand with the code, post a note - otherwise, good luck!

 

[dcardno]

I was curious, so I did it anyway...

Function PropNum(stInput As String) As String
'returns stInput in Proper Case, with Roman Numeral suffixes
'(as in John Smith IV) in Upper Case.
'Possible errors flagged by appending "**" as an error code

Dim stData     As String
Dim i          As Integer
Dim stError    As String

stData = Trim(stInput)
If iVal(stData, 0) = 2 Then
    PropNum = WorksheetFunction.Proper(stData)
Else

    For i = 1 To Len(stData)
        Select Case iVal(stData, i)
            Case 0
                Exit For
            Case 2
                stError = "**"
                Exit For
            Case 1
        End Select
    Next i

PropNum = WorksheetFunction.Proper(Left(stData, Len(stData) - i))
PropNum = PropNum & UCase(Right(stData, i))
PropNum = PropNum & stError

End If
End Function

Function iVal(stData As String, iChar As Integer) As Integer
' returns value to indicate whether a selected character
' in a string could be part of a Roman Numeral suffix,
' ie John Jones IV
' return values:
' if possible Rom Numeral: 1
'                   space: 0
'       not a Rom Numeral: 2

Select Case UCase(Mid(stData, Len(stData) - iChar, 1))
    Case "I", "V", "X"
        iVal = 1
    Case " "
        iVal = 0
    Case Else
        iVal = 2
End Select

End Function

Edited to start the inspection with the last character, rather than second-last
This will return Proper Case names and UPPER CASE Roman Numeral suffixes for any length of RN suffix (although I didn't include L, D or M as possible RN Components. It will append an error code of ** to the value if it encounters an unusual condition - typically a missing space, so:
"JOHN JONES IV" returns John Jones IV, while
"JOHN JONESIV" returns John JonesIV** and
"JOHN JONES,IV" returns John Jones,IV**

 

[West Man]

If you use PROPER to convert addresses, you will have a whole lot of "exceptions" where the conversion is not what you desire. I have identified over 50 of them and fix them through a series of substitutions.

 

[Scott Huish]

dcardno:
That has problems if the last name was Olive for example.

Perhaps:

Function PropNum(stInput As String) As String

Dim stData
Dim i As Integer
Dim j As Integer
Dim u As Integer

stData = Split(stInput)
i = ARABIC(stData(UBound(stData)))
u = UBound(stData)
For j = 0 To u
    stData(j) = Application.WorksheetFunction.Proper(stData(j))
Next j

If IsNumeric(i) Then
    If i > 0 Then
        If UCase(stData(u)) = Application.WorksheetFunction.roman(i) Then _
            stData(u) = UCase(stData(u))
    End If
End If

PropNum = Join(stData)
End Function

Private Function ARABIC(ByVal r As String) As Variant
Dim i As Integer
Dim ch As String
Dim result As Long
Dim new_value As Long
Dim old_value As Long

r = UCase$(r)
old_value = 1000

For i = 1 To Len(r)
    ch = Mid$(r, i, 1)
    Select Case ch
        Case "I"
            new_value = 1
        Case "V"
            new_value = 5
        Case "X"
            new_value = 10
        Case "L"
            new_value = 50
        Case "C"
            new_value = 100
        Case "D"
            new_value = 500
        Case "M"
            new_value = 1000
        Case Else
            ARABIC = -1
            Exit Function
    End Select

    If new_value > old_value Then
        result = result + new_value - 2 * old_value
    Else
        result = result + new_value
    End If

    old_value = new_value
Next i
ARABIC = result
End Function

Book4
	C	D	E	F
8	james fox iv	James Fox IV
9	joe olive	Joe Olive
10	joe green xx	Joe Green XX
11	fred james mcm	Fred James MCM
12	fred vim	Fred Vim
13	fred jones vi	Fred Jones VI
14	scott xil	Scott Xil
Sheet1