Splitting cell entries of variable length

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Joe - 31 Jan 2006 13:35 GMT

Hi,

I would like to have a Macro to split the text entries in one cell into
two or more other cells.

eg: if the entries are like:

Cell D2 : "CX55742A-CI CY55742AAA-CI#"
Cell D3: "BY58575B-BB"
Cell D4: "95033 95982111S 95982199"
Cell D5: "01722000 05134800 05317500 74710286 74710286
95052924"
etc,

what i would like to do is to split D2 into:

E2: "CX55742A-CI"
F2: "CY55742AAA-CI#",

split D4 into:
E4: 95033
F4: 95982111S
G4: 95982199

etc

I guess I should read from the left, look for spaces in the text, and
split the entry right where the space is, move to the next actual text
entry, etc. However, please note that:

1. I dont know in advance how many sub-text entries are going to be in
one cell, so I dont know how many columns I'd be splitting this into

2. The part numbers have different string lengths, so I cant use the
easier way of saying "pick the first 8 characters and put em in E2, the
next 5 in F2, etc

Do you think you could help me with this? Thanks a lot in advance.

Joe.

Reply to this Message

Norman Jones - 31 Jan 2006 13:45 GMT

Hi Joe,

You could do this manually using Data | Text to Columns, but try:

Public Sub TesterX()
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim LRow As Long
Dim sStr As String
Dim arr As Variant
Dim i As Long

Application.ScreenUpdating = False

Set SH = ActiveSheet

LRow = SH.Cells(Rows.Count, "D").End(xlUp).Row

Set rng = SH.Range("D2:D" & LRow) ' or Selection

For Each rCell In rng.Cells
sStr = rCell.Value
arr = Split(sStr, " ")
i = UBound(arr) - LBound(arr) + 1
rCell(1, 2).Resize(1, i).Value = arr
Next rCell

Application.ScreenUpdating = True

End Sub
'<<=============

Signature

---
Regards,
Norman

> Hi,
>
[quoted text clipped - 36 lines]
>
> Joe.

Reply to this Message

Joe - 31 Jan 2006 14:33 GMT

Hi Norman,

YOU'RE DA MAN!!!!!!

Several people had tried to tackle this, but you are the first one to
solve it. Thanks a lot for your help.

However, there is one bug - Do you think you can llook into it?

Some entries in Col D are blank. Now when the program hits an empty
cell, it stops, and throws up an error, saying "Application-defined or
object-defined error".

Thanks,

Joe.

Reply to this Message

Norman Jones - 31 Jan 2006 14:40 GMT

Hi Joe,

> However, there is one bug - Do you think you can llook into it?
>
> Some entries in Col D are blank. Now when the program hits an empty
> cell, it stops, and throws up an error, saying "Application-defined or
> object-defined error".

Try:
'=============>>
Public Sub TesterX2()
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim LRow As Long
Dim sStr As String
Dim arr As Variant
Dim i As Long

Application.ScreenUpdating = False

Set SH = ActiveSheet

LRow = SH.Cells(Rows.Count, "D").End(xlUp).Row

Set rng = SH.Range("D2:D" & LRow)

For Each rCell In rng.Cells
With rCell
sStr = .Value
If Not IsEmpty(.Value) Then
arr = Split(sStr, " ")
i = UBound(arr) - LBound(arr) + 1
rCell(1, 2).Resize(1, i).Value = arr
End If
End With
Next rCell

Application.ScreenUpdating = True

End Sub
'<<=============

---
Regards,
Norman

Reply to this Message

Joe - 31 Jan 2006 15:10 GMT

Beautiful, Norman ! It runs perfect ! You saved my life once again.
Thanks a bunch !

Joe.

Reply to this Message

Tom Ogilvy - 31 Jan 2006 14:49 GMT

For Each rCell In rng.Cells
if not isempty(rCell) then
sStr = rCell.Value
arr = Split(sStr, " ")
i = UBound(arr) - LBound(arr) + 1
rCell(1, 2).Resize(1, i).Value = arr
End if
Next rCell

Signature

Regards,
Tom Ogilvy

> Hi Norman,
>
[quoted text clipped - 12 lines]
>
> Joe.

Reply to this Message

Joe - 31 Jan 2006 22:35 GMT

Thanks a lot, Tom.

Joe.

Reply to this Message

Don Guillett - 31 Jan 2006 13:49 GMT

have a look at Data>text to columns>delimited>space

Signature

Don Guillett
SalesAid Software
dguillett1@austin.rr.com

> Hi,
>
[quoted text clipped - 36 lines]
>
> Joe.

Reply to this Message