Splitting cell entries of variable length

J

Joe

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.
 
N

Norman Jones

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
'<<=============
 
J

Joe

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.
 
N

Norman Jones

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
'<<=============
 
T

Tom Ogilvy

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
 
J

Joe

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

Joe.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top