convert second word in range to Proper when first variable length -urgent please

[pgcn]

Hi - thanks for having a look

I have 1 column of names: D (in a many column worksheet) with initials
and surname in upper case e.g. AB PATTERSON or A PATTERSON and I want
the surname only (not initials) as proper.

Also there is the case of two people e.g. AB PATTERSON & B BANJO

and hyphenated names - e.g. AB PATTERSON-POET

How can I have a function or VBA asertain where the surname/s start
and convert.

Hope someone can help

Cheers
Peta

 

[Rick Rothstein \(MVP - VB\)]

Are there **always** initial in front of each name (single names and names
with & between them)? Is there **ever** any other symbol joining compound
names besides & and dash? Do any names have multiple initials with spaces
between them? Any other type of anomalies that you are aware of?

Rick

 

[pgcn]

I've replied to Rick about an hour ago but it doesn't seem to have
posted.
Apologies if this is a repeat.

Are there **always** initials in front of each name (single names and names
with & between them)?

Yes (1 or 2 with no spaces between)

Is there **ever** any other symbol joining compound
names besides & and dash? No

Do any names have multiple initials with spaces

between them?
No

Any other type of anomalies that you are aware of?

None

Thanks very much
Peta

 

[Rick Rothstein \(MVP - VB\)]

Nope, your first post didn't make it through. Okay, I think the following
will do what you want. Copy/Paste the code below into your worksheet's code
window. There is one macro and one subroutine... the macro that you will
call is named MakeNamesProper (it calls the subroutine as it needs to). I
set code to operate on Column D in Sheet1; change the sheet reference in the
With statement of MakeNamesProper to the name of the sheet with your names
on them. Okay, that is it... go to your sheet and run the MakeNamesProper
macro (Alt+F8)... it should convert all the name in Column D of that sheet
to the format you asked for.

Sub MakeNamesProper()
Dim x As Long
Dim LastRow As Long
Dim Text As String
Dim Parts() As String
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
For x = 1 To LastRow
Text = .Cells(x, "D").Value
Parts = Split(Text, "&")
IndividualName Parts(0)
If InStr(Text, "&") Then IndividualName Parts(1)
Text = Join(Parts, "&")
.Cells(x, "D").Value = Text
Next
End With
End Sub

Sub IndividualName(Text As String)
Dim Dash As Long
Dim Space As Long
Text = StrConv(Text, vbProperCase)
If InStr(Text, "-") Then
Dash = InStr(Text, "-")
Mid(Text, Dash) = " "
Mid(Text, Dash) = "-"
End If
Space = InStr(Text, " ")
Mid(Text, 1) = UCase(Left(Text, Space - 1))
End Sub

Rick

 

[pgcn]

Nope, your first post didn't make it through. Okay, I think the following
will do what you want. Copy/Paste the code below into your worksheet's code
window. There is one macro and one subroutine... the macro that you will
call is named MakeNamesProper (it calls the subroutine as it needs to). I
set code to operate on Column D in Sheet1; change the sheet reference in the
With statement of MakeNamesProper to the name of the sheet with your names
on them. Okay, that is it... go to your sheet and run the MakeNamesProper
macro (Alt+F8)... it should convert all the name in Column D of that sheet
to the format you asked for.

Sub MakeNamesProper()
  Dim x As Long
  Dim LastRow As Long
  Dim Text As String
  Dim Parts() As String
  With Worksheets("Sheet1")
    LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
    For x = 1 To LastRow
      Text = .Cells(x, "D").Value
      Parts = Split(Text, "&")
      IndividualName Parts(0)
      If InStr(Text, "&") Then IndividualName Parts(1)
      Text = Join(Parts, "&")
      .Cells(x, "D").Value = Text
    Next
  End With
End Sub

Sub IndividualName(Text As String)
  Dim Dash As Long
  Dim Space As Long
  Text = StrConv(Text, vbProperCase)
  If InStr(Text, "-") Then
    Dash = InStr(Text, "-")
    Mid(Text, Dash) = " "
    Mid(Text, Dash) = "-"
  End If
  Space = InStr(Text, " ")
  Mid(Text, 1) = UCase(Left(Text, Space - 1))
End Sub

Rick






- Show quoted text -

That's brilliant - saved me so much work.

Just two little hiccups - my fault - didn't mention it
apostrophe surnames & hyphenated: e.g. O'Brien-Radford (required) -
got O'brien-radford.

Thanks so much Rick

 

[Rick Rothstein \(MVP - VB\)]

Just two little hiccups - my fault - didn't mention it

apostrophe surnames & hyphenated:
e.g. O'Brien-Radford (required) -
got O'brien-radford.

So, you lied to me... there was another linking character and/or anomaly,
huh?<g> No problem... as it turns out, I had left a statement out of the
code I posted which means no hyphenated name would have been handled
correctly. Replace all the code I gave you in my other response with the
following code which will handle names with apostrophes and dashes
correctly. You can run the macro against your existing data even if it
contains properly formatted names... the routine will simply replace
correctly formatted names with itself; but, in the meantime, it will
straighten out dashed and apostrophe'd names.

Sub MakeNamesProper()
Dim X As Long
Dim LastRow As Long
Dim Apostrophe As Long
Dim Text As String
Dim Parts() As String
With Worksheets("Sheet3")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
For X = 1 To LastRow
Text = .Cells(X, "D").Value
Parts = Split(Text, "&")
IndividualName Parts(0)
If InStr(Text, "&") Then IndividualName Parts(1)
Text = Join(Parts, "&")
If InStr(Text, "'") Then
Apostrophe = InStr(Text, "'")
Mid(Text, Apostrophe + 1) = UCase(Mid(Text, Apostrophe + 1, 1))
End If
.Cells(X, "D").Value = Text
Next
End With
End Sub

Sub IndividualName(Text As String)
Dim Dash As Long
Dim Space As Long
Text = StrConv(Text, vbProperCase)
If InStr(Text, "-") Then
Dash = InStr(Text, "-")
Mid(Text, Dash) = " "
Text = StrConv(Text, vbProperCase)
Mid(Text, Dash) = "-"
End If
Space = InStr(Text, " ")
Mid(Text, 1) = UCase(Left(Text, Space - 1))
End Sub

Rick