PLS SUGEST VB CODE TO REMOVE INITIALS FROM NAME AND ATTACH IT TO THE END OF THE NAME

[CAPTGNVR]

DAER ALL
I have 3 thou odd names in excel97. The names are entered like
A.S.R.CHARLIE;
P.K.WHITE; M.PETER and so on.

Can u pls sugest VB code so that I can run through each cell and take
these initials and attach it at the end of the name after giving a
space or two like CHARLIE A.S.R; PETER M. and so on. Pls
help.

 

[Guest]

Sub initializer()
For Each r In Selection
s = Split(r.Value, ".")
l = UBound(s)
f = LBound(s)
recon = s(l) & " "
j = 0
For i = f To l - 1
If j = 0 Then
recon = recon & s(i)
j = 1
Else
recon = recon & "." & s(i)
End If
Next
r.Value = recon
Next
End Sub

 

[Ron Rosenfeld]

DAER ALL
I have 3 thou odd names in excel97. The names are entered like
A.S.R.CHARLIE;
P.K.WHITE; M.PETER and so on.

Can u pls sugest VB code so that I can run through each cell and take
these initials and attach it at the end of the name after giving a
space or two like CHARLIE A.S.R; PETER M. and so on. Pls
help.

================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Dim oMatchCollection As Object
Dim i As Long
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
Debug.Print oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub
====================================

However, the above assumes all of your entries consist of initials (capital
letter followed by a dot) followed by a single name.

Do you have other variations?

Such as M.Peter James?

If so, what do you want as a result.

================================

Obviously, instead of printing the results in the immediate window, you might
want to either change the data in place, or print the corrected data in some
other column.

The following will print the data in the adjacent column:

=====================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Dim oMatchCollection As Object
Dim i As Long
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
c.Offset(0, 1).ClearContents
c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub
====================================
--ron

 

[Ron Rosenfeld]

=====================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Dim oMatchCollection As Object
Dim i As Long
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
c.Offset(0, 1).ClearContents
c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub

Superfluous lines removed

=====================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
c.Offset(0, 1).ClearContents
c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub
================================

--ron

 

[Guest]

Dear Gary
First of all sorry for being so late in following this up. It is mainly
bcos i was waiting in the google and missed out all these response. Pls be
tolerant.

Itried your code and it gives COMPILE ERROR --SUB OR FUCNTION NOT DEFINED at
s = Split(r.Value, ".")

Pls be informed that I have only excel97. Do u mind explaining what is this
'split' about??? When i go for help it shows only about splitting the
windows.

 

[Guest]

Dear Ron
First of all sorry for being so late in following this up. It is mainly
bcos i was waiting in the google and missed out all these response. Pls be
tolerant.

The code is way above my comprehension as I am still at primitive stage.

Can u tell me what the below lines mean??
1. Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

"(([A-Z]\.\s?)*)(\w+)" pls explain.


2. Set oRegex = CreateObject("VBScript.Regexp")

CreateObject("VBScript.Regexp") pls explain

3. oRegex.Pattern = sPattern

4. c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
oRegex.Replace(c.Text, "$3 $1") pls eplain about $3 $1

5. finally yes I have double names also like P.V.R ALEX MATHEW AND SO ON

I did try this code and with offset it did change the initials to the end of
the name. Would appreciate little explanaiton so that i can understand how
it is working.
Pls be informed that I have only excel97.

=====================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Dim oMatchCollection As Object
Dim i As Long
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
c.Offset(0, 1).ClearContents
c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub

Superfluous lines removed

=====================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
c.Offset(0, 1).ClearContents
c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub
================================

--ron

 

[Guest]

D/RON
If u find it troublesom to explain at least let me know some links where i
can read up this """"""Set oRegex = CreateObject("VBScript.Regexp")""" etc.
Eagerly awaiting a brief explanation.
with rgds/captgnvr

=====================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Dim oMatchCollection As Object
Dim i As Long
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
c.Offset(0, 1).ClearContents
c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub

Superfluous lines removed

=====================================
Option Explicit
Sub MoveInit()
Dim c As Range
Dim oRegex As Object
Const sPattern As String = "(([A-Z]\.\s?)*)(\w+)"

Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.ignorecase = False
oRegex.Pattern = sPattern

For Each c In Selection
c.Offset(0, 1).ClearContents
c.Offset(0, 1).Value = oRegex.Replace(c.Text, "$3 $1")
Next c
End Sub
================================

--ron