Sub SplitNames()
Dim r As Long
Dim lr As Long
Dim ln As Long
Dim c As Long
Dim a As Long
Dim b As String
Application.ScreenUpdating = False
' Find last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row
' Loop through all rows, starting on row 1
For r = 1 To lr
' Find length of entry
ln = Len(Cells(r, "A"))
' Loop through entry
If ln > 1 Then
For c = 2 To ln
' Get ASCII code of character
a = Asc(Mid(Cells(r, "A"), c, 1))
'Get character in previous spot
b = Mid(Cells(r, "A"), c - 1, 1)
' Check to see if character is a capital letter
If (a >= 65) And (a <= 90) And (b <> " ") Then
' Return parts to columns B and C
Cells(r, "B") = Left(Cells(r, "A"), c - 1)
Cells(r, "C") = Mid(Cells(r, "A"), c)
Exit For
End If
Next c
End If
Next r
Application.ScreenUpdating = True
End Sub