NEED VB TO REMOVE INITIALS FROM A NAME

[CAPTGNVR]

DEAR ALL
I have in excel-97, some 3 thou odd names. But the names have
initials like A.R.S.CHARLIE; K.T.WHITE; B.PHILIPS and so on. Can you
pls sugest a VB code so that it goes through each cell and removes the
initials and adds it to the end of the name by giving a space -like
CHARLIE A.R.S; WHITE K.T; PHILIPS B. Pls guide
me.

 

[Kevin Jones]

Add this macro to any general code module, select the cells to convert, and
run the macro.

Public Sub ConvertNames()

Dim RegEx As Object
Dim Cell As Range
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Global = True
RegEx.MultiLine = True
RegEx.IgnoreCase = True
RegEx.Pattern = "^([a-z..]*\.)([a-z]+)$"

For Each Cell In Selection
Cell = RegEx.Replace(Cell, "$2 $1")
Next Cell

End Sub

Kevin

 

[Jim Thomlinson]

Kevin - Very interesting solution. Does a RegExp have any kind of a
performance gain (or loss) over using regular VBA functions?

Just a note to CAPTNGNVR this solution does not differentiate between
formulas and values and will overwrite any formulas with values. My solution
assumed you did not want to overwrite formulas.

 

[Kevin Jones]

If used smartly, RegExp does perform quite well. The bulk of the time
consumed is in the instantiating and initializing of the scripting
environment. These two routines do the same function. I ran each on Excel
2003 on 65,000 names. The RegExp version took 3.75 seconds and the InStrRev
version took 5.92 seconds.

Public Sub ConvertNames1()

Dim RegEx As Object
Dim Cell As Range
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Global = True
RegEx.MultiLine = True
RegEx.IgnoreCase = True
RegEx.Pattern = "^([a-z..]*\.)([a-z]+)$"

Dim TimeMark As Double

TimeMark = Timer

For Each Cell In Selection
Cell = RegEx.Replace(Cell, "$2 $1")
Next Cell

MsgBox Timer - TimeMark

End Sub

Public Sub ConvertNames2()

Dim Cell As Range
Dim Pos As Long

Dim TimeMark As Double

TimeMark = Timer

For Each Cell In Selection
Pos = InStrRev(Cell, ".")
If Pos > 0 Then
Cell = Mid(Cell, Pos + 1) & " " & Left(Cell, Pos - 1)
End If
Next Cell

MsgBox Timer - TimeMark

End Sub

Kevin

Kevin - Very interesting solution. Does a RegExp have any kind of a
performance gain (or loss) over using regular VBA functions?

Just a note to CAPTNGNVR this solution does not differentiate between
formulas and values and will overwrite any formulas with values. My solution
assumed you did not want to overwrite formulas.
--
HTH...

Jim Thomlinson

Add this macro to any general code module, select the cells to convert, and
run the macro.

Public Sub ConvertNames()

Dim RegEx As Object
Dim Cell As Range
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Global = True
RegEx.MultiLine = True
RegEx.IgnoreCase = True
RegEx.Pattern = "^([a-z..]*\.)([a-z]+)$"

For Each Cell In Selection
Cell = RegEx.Replace(Cell, "$2 $1")
Next Cell

End Sub

Kevin

 

[Jim Thomlinson]

Very interesting. I used Mid$ and Left$ to tweak up the performance on my
code but you still beat me by a second. I have to use 2 text functions where
as you get away with just one replace function. That is probalby the
difference. I will probably stick with my code as my regexp is distinctly
poor but it is good to know.

Note to CAPTGNVR - Go with Kevin's code as it will work in 97 and mine will
not. If you need to worry about overwriting formulas (probably not an issue
but who knows) then you can grab the first bit of my code to exclude cells
with formulas.
--
HTH...

Jim Thomlinson

If used smartly, RegExp does perform quite well. The bulk of the time
consumed is in the instantiating and initializing of the scripting
environment. These two routines do the same function. I ran each on Excel
2003 on 65,000 names. The RegExp version took 3.75 seconds and the InStrRev
version took 5.92 seconds.

Public Sub ConvertNames1()

Dim RegEx As Object
Dim Cell As Range
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Global = True
RegEx.MultiLine = True
RegEx.IgnoreCase = True
RegEx.Pattern = "^([a-z..]*\.)([a-z]+)$"

Dim TimeMark As Double

TimeMark = Timer

For Each Cell In Selection
Cell = RegEx.Replace(Cell, "$2 $1")
Next Cell

MsgBox Timer - TimeMark

End Sub

Public Sub ConvertNames2()

Dim Cell As Range
Dim Pos As Long

Dim TimeMark As Double

TimeMark = Timer

For Each Cell In Selection
Pos = InStrRev(Cell, ".")
If Pos > 0 Then
Cell = Mid(Cell, Pos + 1) & " " & Left(Cell, Pos - 1)
End If
Next Cell

MsgBox Timer - TimeMark

End Sub

Kevin

Kevin - Very interesting solution. Does a RegExp have any kind of a
performance gain (or loss) over using regular VBA functions?

Just a note to CAPTNGNVR this solution does not differentiate between
formulas and values and will overwrite any formulas with values. My solution
assumed you did not want to overwrite formulas.
--
HTH...

Jim Thomlinson

Add this macro to any general code module, select the cells to convert, and
run the macro.

Public Sub ConvertNames()

Dim RegEx As Object
Dim Cell As Range
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Global = True
RegEx.MultiLine = True
RegEx.IgnoreCase = True
RegEx.Pattern = "^([a-z..]*\.)([a-z]+)$"

For Each Cell In Selection
Cell = RegEx.Replace(Cell, "$2 $1")
Next Cell

End Sub

Kevin