Split & Rearrange number

[Jeff]

Hi,

My excel file Cell A1 has the following format (Multiple numbers in diff rows)
1234 23244
4434 121 1442
534 121223 12

How do I split & re-arrange the data to 1234 (Cell A1) 23244 (Cell B1) 4434
(Cell C1) etc.. ?

Thanks for your help.

 

[Ron Rosenfeld]

Hi,

My excel file Cell A1 has the following format (Multiple numbers in diff rows)
1234 23244
4434 121 1442
534 121223 12

How do I split & re-arrange the data to 1234 (Cell A1) 23244 (Cell B1) 4434
(Cell C1) etc.. ?

Thanks for your help.

You can use a UDF to do this.

To enter this <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the Project Explorer window, then insert/module and paste the
code below into the window that opens.

Select your data range. Then <alt-F8> and RUN the Rearrange macro.

As written, the numbers are returned as numeric values, so leading zeros will
not be present.

If you require preservation of leading zero's, then note the comment to change
the format of the destination cells.

Also note that if any of your Selected data range is in any of the destination
cells, they will be overwritten and not recoverable. So backup your data.


=================================================
Option Explicit
Sub Rearrange()
Dim c As Range
Dim sTemp
Dim i As Long
For Each c In Selection
sTemp = sTemp & c.Text & " "
Next c
sTemp = Application.WorksheetFunction.Trim(sTemp)
sTemp = Split(sTemp, " ")
Set c = Range("A1")
For i = 0 To UBound(sTemp)
With c(1, i + 1)
.NumberFormat = "General"
'use numberformat @ for returning values as text
'.NumberFormat = "@"
.Value = sTemp(i)
End With
Next i
End Sub
============================================
--ron

 

[Max]

One play which would bring you close ..

Assuming the data as posted is in A1:A3
Select A1:A3, click Data > Text to Columns, delimited.
In step 2, check "Space" > Finish. This splits the data into cols A to C.

Then to extract the contents in A2:C3 into row 1,
you could place this in D1:
=OFFSET($A$2,INT((COLUMNS($A:A)-1)/3),MOD(COLUMNS($A:A)-1,3))
Copy D1 across to I1. Kill the formulas with an "in-place" copy n paste
special as values. Clean up by clearing A2:C3.

The "3" in the OFFSET formula refers to the number of source cols (in the
above, its 3 cols - cols A to C). Adjust to suit.

A better way might be to extract the split data
in cols A to C down a col, instead of across a row.

Eg you could place this instead in say E2:
=OFFSET($A$1,INT((ROWS($1:1)-1)/3),MOD(ROWS($1:1)-1,3))
then copy E2 down as far as required to exhaust the source data,
kill the formulas & clean up by using autofilter on col E,
filter for zero, and delete all zero lines, remove autofilter.

 

[Jeff]

Hi Max, thanks for your reply.

The data is in cell A1 only. Not A1:A3. If using your method, original data

1234 23244
4434 121 1442
534 121223 12

will change to
A B
1 1234 23244
where next row data 4434 121 1442 & 534 121223 122 will be gone. The output
should be

A B C D E F G H
1 1234 23244 4434 121 1442 534 121223 12

Rgds..Jeff

 

[Jeff]

Hi Ron, thanks for your response

I tried your method below and the output as follow
A B C D E F
1 1234 23244 121 1442 121223 12
4434 534
2
3

Where cell B2 and D2 still merge the numbers.

Rgds..Jeff

 

[Ron Rosenfeld]

Hi Ron, thanks for your response

I tried your method below and the output as follow
A B C D E F
1 1234 23244 121 1442 121223 12
4434 534
2
3

Where cell B2 and D2 still merge the numbers.

Rgds..Jeff

Then I didn't understand your question, and/or you didn't understand my
response. My routine will not do that, if your data is as described. As a
matter of fact, unless you have made some changes in what I've supplied, there
is no way that it would even be writing anything in row 2.

What changes did you make? Please post back with more details.

Do you want to split the contents row by row? If so, just use the Data/Text to
Columns wizard.

If you want something else, you'll need to be more specific.
--ron

 

[Ron Rosenfeld]

Hi Ron, thanks for your response

I tried your method below and the output as follow
A B C D E F
1 1234 23244 121 1442 121223 12
4434 534
2
3

Where cell B2 and D2 still merge the numbers.

Rgds..Jeff

OK, I just read your response to Max and see that all of the data is in one
cell -- not on individual rows as I had thought.

Give me a minute.


--ron

 

[Ron Rosenfeld]

Hi Ron, thanks for your response

I tried your method below and the output as follow
A B C D E F
1 1234 23244 121 1442 121223 12
4434 534
2
3

Where cell B2 and D2 still merge the numbers.

Rgds..Jeff

OK, this should work, now that I understand the data to be split is all in one
cell.

I didn't format the destination cell in this version, but that can be easily
added depending on whether you want the values to be text or numeric.

You can still use the Data/Text to columns wizard by specifying the delimiters
as being <space> and <other>. In the <other> box, hold down <alt> while you
type 010 on the NUMERIC KEYPAD (not on the numbers at the top of the keyboard).

If that doesn't work, (and it might if there is something else funny about the
data), you can try the sub below:

====================================
Option Explicit
Sub Rearrange()
Dim c As Range
Dim re As Object, mc As Object
Dim i As Long
Const sPat As String = "\w+"

Set re = CreateObject("vbscript.regexp")
With re
.Global = True
.Pattern = sPat
End With

For Each c In Selection
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
For i = 0 To mc.Count - 1
c.Offset(0, i).Value = mc(i)
Next i
End If
Next c
End Sub
===================================


--ron

 

[Rick Rothstein \(MVP - VB\)]

Give this macro a try...

Sub SplitCellText()
Dim X As Long
Dim Combo As String
Dim Values() As String
Combo = Replace(Replace(Range("A1").Value, vbCr, " "), vbLf, " ")
Do While InStr(Combo, " ")
Combo = Replace(Combo, " ", " ")
Loop
Values = Split(Trim(Combo))
For X = 0 To UBound(Values)
Range("A1").Offset(0, X).Value = Values(X)
Next
End Sub

Rick

 

[Max]

2 superb subs for Jeff to use, one from you, Rick, and the other from Ron's
latest response.

Just one question: Should the number of items split exceed the max number of
cols, how could the results be snaked down to row 2 (& beyond)?

---

 

[Jeff]

Thanks Rick. This macro is very good and meet my expectation.

 

[Jeff]

Thanks Ron, macro is excellent & working well.

OK, this should work, now that I understand the data to be split is all in one
cell.

I didn't format the destination cell in this version, but that can be easily
added depending on whether you want the values to be text or numeric.

You can still use the Data/Text to columns wizard by specifying the delimiters
as being <space> and <other>. In the <other> box, hold down <alt> while you
type 010 on the NUMERIC KEYPAD (not on the numbers at the top of the keyboard).

If that doesn't work, (and it might if there is something else funny about the
data), you can try the sub below:

====================================
Option Explicit
Sub Rearrange()
Dim c As Range
Dim re As Object, mc As Object
Dim i As Long
Const sPat As String = "\w+"

Set re = CreateObject("vbscript.regexp")
With re
.Global = True
.Pattern = sPat
End With

For Each c In Selection
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
For i = 0 To mc.Count - 1
c.Offset(0, i).Value = mc(i)
Next i
End If
Next c
End Sub
===================================


--ron

 

[Rick Rothstein \(MVP - VB\)]

Just one question: Should the number of items split exceed the max number

of cols, how could the results be snaked down to row 2 (& beyond)?

For my approach, like this...

Sub SplitCellText()
Dim C As Long
Dim R As Long
Dim Combo As String
Dim Values() As String
Combo = Replace(Replace(Range("A1").Value, vbCr, " "), vbLf, " ")
Do While InStr(Combo, " ")
Combo = Replace(Combo, " ", " ")
Loop
Values = Split(Trim(Combo))
For C = 0 To UBound(Values)
If C Mod Columns.Count = 0 And C > 0 Then R = R + 1
Range("A1").Offset(R, C Mod Columns.Count).Value = Values(C)
Next
End Sub


Rick

 

[Max]

Marvellous revision, Rick.
Thanks.

---

 

[Ron Rosenfeld]

2 superb subs for Jeff to use, one from you, Rick, and the other from Ron's
latest response.

Just one question: Should the number of items split exceed the max number of
cols, how could the results be snaked down to row 2 (& beyond)?

Just a matter of adjusting the Offset. For my routine, try this modification:

==========================================================
Option Explicit
Sub Rearrange()
Dim c As Range
Dim re As Object, mc As Object
Dim i As Long
Const sPat As String = "\w+"

Dim ColCt As Long
ColCt = Columns.Count

Set re = CreateObject("vbscript.regexp")
With re
.Global = True
.Pattern = sPat
End With

For Each c In Selection
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
For i = 0 To mc.Count - 1
c.Offset(Int(i / ColCt), i Mod ColCt).Value = mc(i)
Next i
End If
Next c
End Sub
===================================================================
--ron

 

[Ron Rosenfeld]

Just a matter of adjusting the Offset. For my routine, try this modification:

==========================================================
Option Explicit
Sub Rearrange()
Dim c As Range
Dim re As Object, mc As Object
Dim i As Long
Const sPat As String = "\w+"

Dim ColCt As Long
ColCt = Columns.Count

Set re = CreateObject("vbscript.regexp")
With re
.Global = True
.Pattern = sPat
End With

For Each c In Selection
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
For i = 0 To mc.Count - 1
c.Offset(Int(i / ColCt), i Mod ColCt).Value = mc(i)
Next i
End If
Next c
End Sub
===================================================================
--ron

Hmmm.

Some testing reveals an apparent limitation in the engine underlying my method.
So it will not be able to handle data strings of the length you are
considering. You should use Rick's method, instead.


--ron

 

[Max]

Ron, thanks for posting your mod. Tried it out several times here
but it seems to terminate with the last result placed in HJ1?

---

 

[Max]

Ron, thanks. Noted.
My earlier response crossed your follow up here.

---

 

[Ron Rosenfeld]

Ron, thanks. Noted.
My earlier response crossed your follow up here.

Max,

Further investigation reveals that the problem seems to be a 1024 character
limitation in the .text property of the range object.

Please try this routine instead, on your data, and let me know how it works.

====================================================
Sub Rearrange()
Dim c As Range
Dim re As Object, mc As Object
Dim str As String
Dim i As Long
Const sPat As String = "\w+"

Dim ColCt As Long
ColCt = Columns.Count
Set re = CreateObject("vbscript.regexp")

With re
.Global = True
.Pattern = sPat
End With

For Each c In Selection
str = c
If re.test(str) = True Then
Set mc = re.Execute(str)
For i = 0 To mc.Count - 1
c.Offset(Int(i / ColCt), i Mod ColCt).Value = mc(i)
Next i
End If
Next c
End Sub
==========================================================
--ron

 

[Rick Rothstein \(MVP - VB\)]

Ron, thanks. Noted.

Further investigation reveals that the problem seems to be a 1024
character
limitation in the .text property of the range object.

Please try this routine instead, on your data, and let me know how it
works.

====================================================
Sub Rearrange()
Dim c As Range
Dim re As Object, mc As Object
Dim str As String
Dim i As Long
Const sPat As String = "\w+"

Dim ColCt As Long
ColCt = Columns.Count
Set re = CreateObject("vbscript.regexp")

With re
.Global = True
.Pattern = sPat
End With

For Each c In Selection
str = c
If re.test(str) = True Then
Set mc = re.Execute(str)
For i = 0 To mc.Count - 1
c.Offset(Int(i / ColCt), i Mod ColCt).Value = mc(i)
Next i
End If
Next c
End Sub
==========================================================

At the risk of sounding pedantic, I think your first statement in the For
Each loop should more properly be this...

str = c.Value

But instead of doing this intermediate step of using a String variable, as
above, to feed to the Execute property of your 're' object, you could have
eliminated using this variable and done so directly (the way you did with
the c.Text value originally) like this...

Set mc = re.Execute(c.Value)

....that would have worked too, correct? Or will Execute only accept a typed
String entity in order for it to work?

Rick