NEED VB TO REMOVE INITIALS FROM A NAME
 

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.

NEED VB TO REMOVE INITIALS FROM A NAME
 

Public Sub FixNames()
Dim rng As Range
Dim rngToFix As Range

On Error Resume Next
Set rngToFix = Range(Range("A2"), _
Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstan ts)
On Error GoTo 0

If Not rngToFix Is Nothing Then
For Each rng In rngToFix
rng.Value = ReverseName(rng)
Next rng
End If
End Sub

Private Function ReverseName(ByVal rng As Range) As String
Dim lng As Long

ReverseName = rng.Value
lng = InStrRev(rng.Value, ".")
If lng 0 Then
ReverseName = Trim(Mid(rng.Value, lng + 1, 255)) & _
" " & Left(rng.Value, lng)
End If
End Function
--
HTH...

Jim Thomlinson


"CAPTGNVR" wrote:

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.

NEED VB TO REMOVE INITIALS FROM A NAME
 

Jim,

InStrRev was not introduced until Excel 2000. Asker is using Excel 97.

Kevin

"Jim Thomlinson" wrote:

Public Sub FixNames()
Dim rng As Range
Dim rngToFix As Range

On Error Resume Next
Set rngToFix = Range(Range("A2"), _
Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstan ts)
On Error GoTo 0

If Not rngToFix Is Nothing Then
For Each rng In rngToFix
rng.Value = ReverseName(rng)
Next rng
End If
End Sub

Private Function ReverseName(ByVal rng As Range) As String
Dim lng As Long

ReverseName = rng.Value
lng = InStrRev(rng.Value, ".")
If lng 0 Then
ReverseName = Trim(Mid(rng.Value, lng + 1, 255)) & _
" " & Left(rng.Value, lng)
End If
End Function
--
HTH...

Jim Thomlinson


"CAPTGNVR" wrote:

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.

NEED VB TO REMOVE INITIALS FROM A NAME
 

You are correct. Thanks for catching that. It has been too long since I
worked in 97...
--
HTH...

Jim Thomlinson


"Kevin Jones" wrote:

Jim,

InStrRev was not introduced until Excel 2000. Asker is using Excel 97.

Kevin

"Jim Thomlinson" wrote:

Public Sub FixNames()
Dim rng As Range
Dim rngToFix As Range

On Error Resume Next
Set rngToFix = Range(Range("A2"), _
Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstan ts)
On Error GoTo 0

If Not rngToFix Is Nothing Then
For Each rng In rngToFix
rng.Value = ReverseName(rng)
Next rng
End If
End Sub

Private Function ReverseName(ByVal rng As Range) As String
Dim lng As Long

ReverseName = rng.Value
lng = InStrRev(rng.Value, ".")
If lng 0 Then
ReverseName = Trim(Mid(rng.Value, lng + 1, 255)) & _
" " & Left(rng.Value, lng)
End If
End Function
--
HTH...

Jim Thomlinson


"CAPTGNVR" wrote:

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.