VBA - add special conditions to proper command

K

kristian84

New Member
Joined
Nov 30, 2015
Messages
30
Hi,

I currently run a vba script that looks at a column of last names and runs the proper function. While doing so it also looks for names like McDonald and ensures the 'D' is upper case.

my current script works perfectly.

my new issue is a name such as wagland-mcdonald - my result im getting is "Wagland-Mcdonald" can someone please help me and advise what i'm missing to have the result "Wagland-McDonald"?

thanks

<code>

Public Function fxLastName(ByVal strLastName As String) As String
'Convert last names to proper case with special name consideration
' Mc eg: McGurgan
' O’ eg: O'Shea
' - eg: Sabatino-Morseu
' ' eg: Dell'Aquila

strLastName = Application.Trim(LCase(strLastName))
Select Case True


Case strLastName Like "mc*"
fxLastName = "Mc" & StrConv(Mid(strLastName, 3), vbProperCase)

Case strLastName Like "o'*"
fxLastName = "O'" & StrConv(Mid(strLastName, 3), vbProperCase)

Case strLastName Like "*-*"
fxLastName = Replace(StrConv(Replace(strLastName, "-", " "), vbProperCase), " ", "-")

Case strLastName Like "* (*"
fxLastName = Replace(StrConv(Replace(strLastName, " (", " "), vbProperCase), " ", " (")

Case strLastName Like "*.*"
fxLastName = Replace(StrConv(Replace(strLastName, ".", " "), vbProperCase), " ", ".")

Case strLastName Like "*'*"
fxLastName = Replace(StrConv(Replace(strLastName, "'", " "), vbProperCase), " ", "'")

Case Else
fxLastName = StrConv(strLastName, vbProperCase)
End Select

End Function
</code>
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
I think I'd do it like this:

Code: 
Public Function fxLastName(ByVal strLastName As String) As String
'Convert last names to proper case with special name consideration
' Mc eg: McGurgan
' O’ eg: O'Shea
' - eg: Sabatino-Morseu
' ' eg: Dell'Aquila

strLastName = Trim(LCase(strLastName))
Select Case True
    Case strLastName Like "*-*"
        fxLastName = fixCompoundName(strLastName, "-")

    Case strLastName Like "* (*"
        fxLastName = fixCompoundName(strLastName, " (")

    Case strLastName Like "*.*"
        fxLastName = fixCompoundName(strLastName, ".")

    Case strLastName Like "*'*"
        fxLastName = fixCompoundName(strLastName, "'")

    Case Else
        fxLastName = fixSingleName(strLastName)
End Select

End Function
Private Function fixCompoundName(compoundName As String, delimiter As String) As String

Dim nameParts() As String

nameParts = Split(compoundName, delimiter)
fixCompoundName = fixSingleName(nameParts(0)) & delimiter & fixSingleName(nameParts(1))

End Function
Private Function fixSingleName(singleName As String) As String

If singleName Like "mc*" Then
    fixSingleName = "Mc" & StrConv(Mid(singleName, 3), vbProperCase)
Else
    fixSingleName = StrConv(singleName, vbProperCase)
End If

End Function


Book1
AB
1McgurganMcGurgan
2O'sheaO'Shea
3Sabatino-morseuSabatino-Morseu
4Dell'aquilaDell'Aquila
5Wagland-mcdonaldWagland-McDonald
Sheet1
Cell Formulas
RangeFormula
B1=fxLastName($A1)


WBD
 
Upvote 0
Here is a UDF (user defined function) that I think will handle all of the cases you indicated your function needs to handle...
Code: 
[table="width: 500"]
[tr]
	[td]Function fxLastName(strLastName As String) As String
  Dim Dash As Long
  fxLastName = Application.Trim(Application.Proper(strLastName))
  If fxLastName Like "Mc*" Then Mid(fxLastName, 3) = UCase(Mid(fxLastName, 3, 1))
  If fxLastName Like "*-Mc*" Then
    Dash = InStr(fxLastName, "-")
    Mid(fxLastName, Dash + 3) = UCase(Mid(fxLastName, Dash + 3, 1))
  End If
End Function[/td]
[/tr]
[/table]
Of course this function is not, and cannot be, complete. For example, what if you had a last name of MacArthur? You cannot automatically upper case the fourth character because that would be the wrong thing to do for a name like Macron.
 
Last edited:
Upvote 0
Yep. It's also a struggle with something like "van de Velde" which will come out as "Van De Velde". Lots of edge cases that you can't really deal with. I minimised my code just for laughs:

Code: 
Public Function fxLastName(strLastName As String) As String
Dim bUpper As Boolean, i As Long
For i = 1 To Len(strLastName)
    fxLastName = fxLastName & StrConv(Mid(strLastName, i, 1), IIf(bUpper Or fxLastName = "", vbUpperCase, vbLowerCase))
    bUpper = (LCase(Right(fxLastName, 1)) = UCase(Right(fxLastName, 1))) Or (Right(fxLastName, 2) = "Mc")
Next i
End Function

WBD
 
Upvote 0
wideboydixon said:
I minimised my code just for laughs:
Click to expand...
You inspired me to write a minimized function code solution and here is what I came up with (it's a one liner)...
Code: 
[table="width: 500"]
[tr]
	[td]Function fxLastName(strLastName As String) As String
  fxLastName = Evaluate(Replace("REPLACE(TRIM(PROPER(""@"")),IFERROR(2+FIND(""Mc"",TRIM(PROPER(""@""))),1),1,UPPER(MID(TRIM(PROPER(""@"")),IFERROR(2+FIND(""Mc"",TRIM(PROPER(""@""))),1),1)))", "@", strLastName))
End Function[/td]
[/tr]
[/table]
I am not entirely sure the above is "minimized" over what I posted in Message #3 as there are a lot of characters in that one-liner. Also, (untested) I am pretty sure the code I posted in Message #3 is faster than the above one-liner.

I would point out to the OP that as a result of my writing the above code, it occurred to me that there is a formula solution to the original question (just in case the OP wants to abandon the VBA solution)...
Code: 
[table="width: 500"]
[tr]
	[td]=REPLACE(TRIM(PROPER(A1)),IFERROR(2+FIND("Mc",TRIM(PROPER(A1))),1),1,UPPER(MID(TRIM(PROPER(A1)),IFERROR(2+FIND("Mc",TRIM(PROPER(A1))),1),1)))[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
thank you everyone for your responses it is greatly appreciated.

the best solution for me was the below code.

many thanks to Wideboydixon for taking the time to assist.

wideboydixon said:
I think I'd do it like this:

Code: 
Public Function fxLastName(ByVal strLastName As String) As String
'Convert last names to proper case with special name consideration
' Mc eg: McGurgan
' O’ eg: O'Shea
' - eg: Sabatino-Morseu
' ' eg: Dell'Aquila

strLastName = Trim(LCase(strLastName))
Select Case True
    Case strLastName Like "*-*"
        fxLastName = fixCompoundName(strLastName, "-")

    Case strLastName Like "* (*"
        fxLastName = fixCompoundName(strLastName, " (")

    Case strLastName Like "*.*"
        fxLastName = fixCompoundName(strLastName, ".")

    Case strLastName Like "*'*"
        fxLastName = fixCompoundName(strLastName, "'")

    Case Else
        fxLastName = fixSingleName(strLastName)
End Select

End Function
Private Function fixCompoundName(compoundName As String, delimiter As String) As String

Dim nameParts() As String

nameParts = Split(compoundName, delimiter)
fixCompoundName = fixSingleName(nameParts(0)) & delimiter & fixSingleName(nameParts(1))

End Function
Private Function fixSingleName(singleName As String) As String

If singleName Like "mc*" Then
    fixSingleName = "Mc" & StrConv(Mid(singleName, 3), vbProperCase)
Else
    fixSingleName = StrConv(singleName, vbProperCase)
End If

End Function

AB
McgurganMcGurgan
O'sheaO'Shea
Sabatino-morseuSabatino-Morseu
Dell'aquilaDell'Aquila
Wagland-mcdonaldWagland-McDonald

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]

[TD="align: center"]5[/TD]

</tbody>
Sheet1​

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: #DAE7F5"]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: #DAE7F5"]B1[/TH]
[TD="align: left"]=fxLastName($A1)[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]



WBD
Click to expand...
 
Upvote 0
Hi @Rick Rothstein

your answer in message #3 is great! however I love it in sub not in function is there a way to convert it in a sub()?

Thanks a lot.
Mike
 
Upvote 0
Give this a try (I think it should work)...
VBA Code: 
Sub ProperCaseLastNames()
  Dim Dash As Long, LastName As String, Cell As Range
  For Each Cell In Range("A1:A10")
    LastName = Application.Trim(Application.Proper(Cell.Value))
    If LastName Like "Mc*" Then Mid(LastName, 3) = UCase(Mid(LastName, 3, 1))
    If LastName Like "*-Mc*" Then
      Dash = InStr(LastName, "-")
      Mid(LastName, Dash + 3) = UCase(Mid(LastName, Dash + 3, 1))
    End If
    Cell.Value = LastName
  Next
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Dr. Demento
  • Question Question
Replace a single character after a delimiter
Replies
4
Views
590
yky
Y
C
  • Question Question
Textbox Last Name Multiple Capital Letters
Replies
2
Views
839
Rick Rothstein
Rick Rothstein
B
  • Question Question
Updating Excel Chart range via vba/macros
Replies
1
Views
2K
Derek Brown
D

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,638
Latest member
Oluwabukunmi

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top