Altering code to accomodate empty space
 

I'm using this code to copy and paste 3 character or less names to a sheet in
the workbook called "Short Name". This code picks up names that are in the
column D like "Lee, Barbara" or "Ray, Joyce". The problem is sometimes the
names display with a space before the comma, like "Lee ,Barbara" or "Ray
,Joyce". How can I alter this code to pick up both scenarios? Thanks a
bunch for your help.

Sub ShortName()

Dim sh As Worksheet, sh1 As Worksheet
Dim rw As Long, s As String, ipos As Long
Dim cell As Range, rng As Range
Set sh = ActiveSheet
With sh
Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
End With
rw = 1
Set sh1 = Worksheets("Short Name")
sh.Activate
For Each cell In rng
s = Replace(Trim(cell.Value), " ", "")
ipos = InStr(1, s, ",", vbTextCompare)
If ipos <= 4 And ipos < 0 Then
cell.EntireRow.Copy sh1.Cells(rw, 1)
rw = rw + 1
End If
Next
End Sub

Altering code to accomodate empty space
 

Hi Jouioui,

Have you tried the code with the indicatrd names?

Unless I misunderstand you, the code works for names with, or without, a
space preceding the comma.


---
Regards,
Norman



"JOUIOUI" wrote in message
...
I'm using this code to copy and paste 3 character or less names to a sheet
in
the workbook called "Short Name". This code picks up names that are in
the
column D like "Lee, Barbara" or "Ray, Joyce". The problem is sometimes
the
names display with a space before the comma, like "Lee ,Barbara" or "Ray
,Joyce". How can I alter this code to pick up both scenarios? Thanks a
bunch for your help.

Sub ShortName()

Dim sh As Worksheet, sh1 As Worksheet
Dim rw As Long, s As String, ipos As Long
Dim cell As Range, rng As Range
Set sh = ActiveSheet
With sh
Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
End With
rw = 1
Set sh1 = Worksheets("Short Name")
sh.Activate
For Each cell In rng
s = Replace(Trim(cell.Value), " ", "")
ipos = InStr(1, s, ",", vbTextCompare)
If ipos <= 4 And ipos < 0 Then
cell.EntireRow.Copy sh1.Cells(rw, 1)
rw = rw + 1
End If
Next
End Sub

Altering code to accomodate empty space
 

I'm sorry Norman, I made a mistake, where this code does not work is in names
like "Na , George" or "Hu , Jane". Do you have any idea how I could use code
to delete the space between the letter and the comma?

thanks so much

"Norman Jones" wrote:

Hi Jouioui,

Have you tried the code with the indicatrd names?

Unless I misunderstand you, the code works for names with, or without, a
space preceding the comma.


---
Regards,
Norman



"JOUIOUI" wrote in message
...
I'm using this code to copy and paste 3 character or less names to a sheet
in
the workbook called "Short Name". This code picks up names that are in
the
column D like "Lee, Barbara" or "Ray, Joyce". The problem is sometimes
the
names display with a space before the comma, like "Lee ,Barbara" or "Ray
,Joyce". How can I alter this code to pick up both scenarios? Thanks a
bunch for your help.

Sub ShortName()

Dim sh As Worksheet, sh1 As Worksheet
Dim rw As Long, s As String, ipos As Long
Dim cell As Range, rng As Range
Set sh = ActiveSheet
With sh
Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
End With
rw = 1
Set sh1 = Worksheets("Short Name")
sh.Activate
For Each cell In rng
s = Replace(Trim(cell.Value), " ", "")
ipos = InStr(1, s, ",", vbTextCompare)
If ipos <= 4 And ipos < 0 Then
cell.EntireRow.Copy sh1.Cells(rw, 1)
rw = rw + 1
End If
Next
End Sub