Macro Help €“ Extracting multiple entries from cell
 

Column D consists of cells with one or more entries (alphanumeric), and
sometimes no entries. I need help in writing a macro that examines each cell
in column D, and if it contains only one entry, copies it to column H. If a
cell contains more than one entry (each separated by one or more spaces), the
macro would copy each entry into a separate cell in column H. If a cell in
column D is blank, the macro would skip it and move down to the next cell.
When the macro encounters two consecutive empty cells in column D, the macro
would stop (that's how you know you are at the end of the list). It is
important that all the entries copied to column H are contiguous (i.e., no
blank cells). Any help would be greatly appreciated.

Thanks,

Bob

Macro Help €“ Extracting multiple entries from cell
 

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
v = Split(rng,",")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Column D consists of cells with one or more entries (alphanumeric), and
sometimes no entries. I need help in writing a macro that examines each cell
in column D, and if it contains only one entry, copies it to column H. If a
cell contains more than one entry (each separated by one or more spaces), the
macro would copy each entry into a separate cell in column H. If a cell in
column D is blank, the macro would skip it and move down to the next cell.
When the macro encounters two consecutive empty cells in column D, the macro
would stop (that's how you know you are at the end of the list). It is
important that all the entries copied to column H are contiguous (i.e., no
blank cells). Any help would be greatly appreciated.

Thanks,

Bob

Macro Help €“ Extracting multiple entries from cell
 

Tom,
Thanks! Your macro worked, except that it doesn't separate multi-entry
cells into separate cells. For example, assume:

Cell D1=P8314 P6684 P6683
Cell D2=P8003
Cell D3=P9015 P8314

Therefore, I would want column H to contain:

Cell H1=P8314
Cell H2=P6684
Cell H3=P6683
Cell H4=P8003
Cell H5=P9015
Cell H6=P8314

Can your macro be modified to do this?
Thanks again for all your help. I really appreciate it.
Bob


"Tom Ogilvy" wrote:

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
v = Split(rng,",")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Column D consists of cells with one or more entries (alphanumeric), and
sometimes no entries. I need help in writing a macro that examines each cell
in column D, and if it contains only one entry, copies it to column H. If a
cell contains more than one entry (each separated by one or more spaces), the
macro would copy each entry into a separate cell in column H. If a cell in
column D is blank, the macro would skip it and move down to the next cell.
When the macro encounters two consecutive empty cells in column D, the macro
would stop (that's how you know you are at the end of the list). It is
important that all the entries copied to column H are contiguous (i.e., no
blank cells). Any help would be greatly appreciated.

Thanks,

Bob

Macro Help €“ Extracting multiple entries from cell
 

My mistake - I thought you post said that multientries were separated by a
comma:

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant, s as String
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
s = Application.Trim(rng)
v = Split(s," ")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Tom,
Thanks! Your macro worked, except that it doesn't separate multi-entry
cells into separate cells. For example, assume:

Cell D1=P8314 P6684 P6683
Cell D2=P8003
Cell D3=P9015 P8314

Therefore, I would want column H to contain:

Cell H1=P8314
Cell H2=P6684
Cell H3=P6683
Cell H4=P8003
Cell H5=P9015
Cell H6=P8314

Can your macro be modified to do this?
Thanks again for all your help. I really appreciate it.
Bob


"Tom Ogilvy" wrote:

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
v = Split(rng,",")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Column D consists of cells with one or more entries (alphanumeric), and
sometimes no entries. I need help in writing a macro that examines each cell
in column D, and if it contains only one entry, copies it to column H. If a
cell contains more than one entry (each separated by one or more spaces), the
macro would copy each entry into a separate cell in column H. If a cell in
column D is blank, the macro would skip it and move down to the next cell.
When the macro encounters two consecutive empty cells in column D, the macro
would stop (that's how you know you are at the end of the list). It is
important that all the entries copied to column H are contiguous (i.e., no
blank cells). Any help would be greatly appreciated.

Thanks,

Bob

Macro Help €“ Extracting multiple entries from cell
 

Tom,
Your macro works perfectly now. Thanks a million (and thanks for all your
time to help me)! I sincerely appreciate it.
Regards, Bob


"Tom Ogilvy" wrote:

My mistake - I thought you post said that multientries were separated by a
comma:

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant, s as String
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
s = Application.Trim(rng)
v = Split(s," ")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Tom,
Thanks! Your macro worked, except that it doesn't separate multi-entry
cells into separate cells. For example, assume:

Cell D1=P8314 P6684 P6683
Cell D2=P8003
Cell D3=P9015 P8314

Therefore, I would want column H to contain:

Cell H1=P8314
Cell H2=P6684
Cell H3=P6683
Cell H4=P8003
Cell H5=P9015
Cell H6=P8314

Can your macro be modified to do this?
Thanks again for all your help. I really appreciate it.
Bob


"Tom Ogilvy" wrote:

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
v = Split(rng,",")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Column D consists of cells with one or more entries (alphanumeric), and
sometimes no entries. I need help in writing a macro that examines each cell
in column D, and if it contains only one entry, copies it to column H. If a
cell contains more than one entry (each separated by one or more spaces), the
macro would copy each entry into a separate cell in column H. If a cell in
column D is blank, the macro would skip it and move down to the next cell.
When the macro encounters two consecutive empty cells in column D, the macro
would stop (that's how you know you are at the end of the list). It is
important that all the entries copied to column H are contiguous (i.e., no
blank cells). Any help would be greatly appreciated.

Thanks,

Bob

Macro Help €“ Extracting multiple entries from cell
 

Tom,
I hate to bother you, but is there a way to have your macro start with cell
D2 (rather than D1)? Thanks.
regards, Bob


"Tom Ogilvy" wrote:

My mistake - I thought you post said that multientries were separated by a
comma:

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant, s as String
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
s = Application.Trim(rng)
v = Split(s," ")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Tom,
Thanks! Your macro worked, except that it doesn't separate multi-entry
cells into separate cells. For example, assume:

Cell D1=P8314 P6684 P6683
Cell D2=P8003
Cell D3=P9015 P8314

Therefore, I would want column H to contain:

Cell H1=P8314
Cell H2=P6684
Cell H3=P6683
Cell H4=P8003
Cell H5=P9015
Cell H6=P8314

Can your macro be modified to do this?
Thanks again for all your help. I really appreciate it.
Bob


"Tom Ogilvy" wrote:

Sub ProcessData()
Dim rw as Long, i as Long
Dim v as Variant
rw = 1
set rng = cells(1,"D")
do while Application.Counta(rng.Resize(2,1)) < 0
if not isempty(rng) then
v = Split(rng,",")
for i = lbound(v) to ubound(v)
cells(rw,"H").Value = v(i)
rw = rw + 1
Next
end if
set rng = rng.offset(1,0)
Loop
End Sub

--
Regards,
Tom Ogilvy


"Bob" wrote:

Column D consists of cells with one or more entries (alphanumeric), and
sometimes no entries. I need help in writing a macro that examines each cell
in column D, and if it contains only one entry, copies it to column H. If a
cell contains more than one entry (each separated by one or more spaces), the
macro would copy each entry into a separate cell in column H. If a cell in
column D is blank, the macro would skip it and move down to the next cell.
When the macro encounters two consecutive empty cells in column D, the macro
would stop (that's how you know you are at the end of the list). It is
important that all the entries copied to column H are contiguous (i.e., no
blank cells). Any help would be greatly appreciated.

Thanks,

Bob