VBA for Proper Case including micks n macks

[jayjaysb]

Hello all,

I am looking for some help, excel 03. Could you give me VBA on proper case for the whole workbook. I am looking for the cells to auto change when someone populates it, e.g from john smith to John Smith, or john mcsmith to John McSmith, note the capital S too.

Also I already have a different VBA in the worksheet do I just go below "end sub" and put in the one you give me, Hope I am making sense and not non - sense

Cheers

JJSB

[TABLE="width: 300"]
<colgroup><col span="2"><col><col></colgroup><tbody>[TR]
[TD]Ref No[/TD]
[TD]Area[/TD]
[TD]First Name[/TD]
[TD]Surname[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]North[/TD]
[TD]jean[/TD]
[TD]smith[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]South[/TD]
[TD]john[/TD]
[TD]mcgill[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]North[/TD]
[TD]peter[/TD]
[TD]cole[/TD]
[/TR]
[TR]
[TD="align: right"]4[/TD]
[TD]South[/TD]
[TD]jessie[/TD]
[TD]maine[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[TD]South[/TD]
[TD]colin[/TD]
[TD]mcgrory[/TD]
[/TR]
</tbody>[/TABLE]

 

[vaskov17]

Go into the VBA editor and on the left side you will see something like:

- VBAProject(Book1)
- Microsoft Excel Objects
-Sheet1
-Sheet2
-Sheet3
-ThisWorkbook

Double click on "ThisWorkbook" and put the following code in there:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Target = StrConv(Target.Text, vbProperCase)
End Sub

 

[jayjaysb]

Vaskov17, thanks for that, works a treat. Do you know how to make it change the surname 3rd or 4th letter like mcgill to McGill or macgill to MacGill. Thanks in advance

JJSB

 

[Rick Rothstein]

Vaskov17, thanks for that, works a treat. Do you know how to make it change the surname 3rd or 4th letter like mcgill to McGill or macgill to MacGill. Thanks in advance

Maybe changing vaskov17's code to this...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Cell As Range, S As String
    For Each Cell In Target
        S = StrConv(Cell.Text, vbProperCase)
        If " " & S Like "* Mc*" Then
            Mid(S, InStr(S, "Mc") + 2) = UCase(Mid(S, InStr(S, "Mc") + 2, 1))
        ElseIf " " & S Like "* Mac*" Then
            Mid(S, InStr(S, "Mac") + 3) = UCase(Mid(S, InStr(S, "Mac") + 3, 1))
        End If
        Cell.Value = S
    Next
End Sub

But note, this will wrongly change names like Macy, Mack, Macina, etc. to MacY, MacK, MacIna, etc. as well as plain words like Machine to MacHine.

 

[jayjaysb]

Thanks Rick, much obliged to you. I am amazed at the help on here.

Cheers

JJSB

 

[Rick Rothstein]

Thanks Rick, much obliged to you. I am amazed at the help on here.

You are welcome, but I have a small modification to make in my code... the For statement needs to be modified slightly to protect against your selecting all the cells (or any large number of cells) and clearing them. Use this code instead of what I gave you earlier...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Cell As Range, S As String
    For Each Cell In Intersect(Target, ActiveSheet.UsedRange)
        S = StrConv(Cell.Text, vbProperCase)
        If " " & S Like "* Mc*" Then
            Mid(S, InStr(S, "Mc") + 2) = UCase(Mid(S, InStr(S, "Mc") + 2, 1))
        ElseIf " " & S Like "* Mac*" Then
            Mid(S, InStr(S, "Mac") + 3) = UCase(Mid(S, InStr(S, "Mac") + 3, 1))
        End If
        Cell.Value = S
    Next
End Sub

 

[jayjaysb]

Many thanks from Old Caledonia.

JJSB