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

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" <[email protected]> wrote in message
news:[email protected]...
> 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

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" <[email protected]> wrote in message
> news:[email protected]...
> > 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
>
>
>