Split one column into five columns

[maperalia]

I have a data that look like this:
1
2
3
4
5
6
8
10
2a
2b
2d
3a
3b
3b
4a
4b
4c
4d
5b
5d
5d
5d


I want to split it in five columns like the following:

1
2
3
4
5
6
8
10
2a
3a
4a
2b
3b
3b
4b
5b
4c
2d
4d
5d
5d
5d


Then split the column with text in two each one.

Can you give help me with any program that can do this because the real data
has more than 30,000 rows I am doing manually all the time.

Thnaks in advance.
Maperalia

 

[Tim Williams]

Might consider reposting your sample data and desired outcome...

 

[Tom Ogilvy]

Sort on column B.

If everything is in a single column, then you can use a formula like

=if(len(A1)=2,Right(A1,1),"")

then drag fill that down column B and then sort on column B.

 

[Kotaro]

What he means is that on his Worksheet he has 3000 rows of data in the same
column, like for example from A1 to A3000.

Using this example, he wants to to split his data from his initial column
into five.
What is not clear to me is every how many rows do you want to skip on to the
next column? Or was your example accurate, meaning you want the following
setup:

10 Rows in Column 1, then jump to Column2
3 Rows in Column 2, then jump to Column3
5 Rows in Column 3, then jump to Column4
1 Row in Column 4, then jump to Column5
5 Rows in Column5, then jump back to Column1 (repeat) ???

Please clarify so that we may assist you.

 

[Tim Williams]

Here's the first part - split the selected cells to 5 columns.
But are you oversimplifying your data?

Tim

'*********************************
Option Explicit

Sub ReformatData()

Dim c As Range
Dim s As String
Dim t

For Each c In Selection

t = Trim(c.Value)
If t <> "" Then

If IsNumeric(t) Then
c.Offset(0, 1).Value = t
Else
s = Right(t, 1)
c.Offset(0, Asc(s) - 95).Value = t
End If
End If
Next c
End Sub
'*********************************

 

[maperalia]

Gentlemen;
Thanks for your quick response.
1.- What is the Outcome?
The outcome is to get in another sheet the list of values repeated and
missing which but the way I have the program (see below) but just take
values without text.

2.- How many rows do you want to skip on to the next column?
I want to skip to the next column as soon as the number has text (i.e. 2a,
2b, etc)
Then create a column with the numbers which have the text â€aâ€. Skip again to
the next column.
Then create a column with the numbers which have the text “bâ€. Skip again to
the next column.
Then create a column with the numbers which have the text “câ€. Skip again to
the next column.
Then create a column with the numbers which have the text “dâ€. Skip again to
the next column and so on.

The reason I want to this is because I will copy each new column in
different sheets then split them to get just the number and run the program
to get the repeated and missing numbers. Otherwise if you have another way to
advice me to do it I will really appreciate.

Kind regards.
Maperalia



‘****START PROGRAM****************************
Sub FindMissingAndDuplicates()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim v() As Long
Dim missing() As Long
Dim i As Long
Dim lastrow As Long


'*****Find the Minimum and Maximum Number*********
sblock = Application.InputBox("Enter block start")
fblock = Application.InputBox("Enter block end")
'*************************************************

ReDim v(fblock - sblock + 1)

j = 0
For i = sblock To fblock
v(j) = i
j = j + 1
Next i

'****Read the Numbers on the Test Numbers Sheet********
Set ws1 = Worksheets("Test Numbers")
'******************************************************

'****Write the Missed and Duplicated Number on the Missing and Duplicated
Numbers Sheet********
Set ws2 = Worksheets("Missing and Duplicated Numbers")
ws2.Range("a1:b1") = Array("Missing", "Duplicated")
'**********************************************************************************************

With ws1
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Range("a1:a" & lastrow)
End With

n1 = 2
n2 = 2
For i = LBound(v) To UBound(v)
If IsError(Application.Match(v(i), rng, 0)) Then
ws2.Cells(n1, 1) = v(i)
n1 = n1 + 1
Else
If Application.CountIf(rng, v(i)) > 1 Then
ws2.Cells(n2, 2) = v(i)
n2 = n2 + 1
End If
End If
Next i
End Sub

‘****END PROGRAM****************************

 

[maperalia]

Tim;
Thanks for your program it is working perfectly!!!!... It is exactly what I
was looking for.

However, I ran a new data that has four digits and 300 rows and the program
does not offset the numbers with the text. In addition has the following
error message:

Run Time error '1004':
Application-Defined or Object-Defined Error

Then when I click Debug it is highlighting at:

c.Offset(0, Asc(s) - 95).Value = t

I could not find the way to fix it. Could you please help me with this matter?

Thanks
Maperalia

 

[Tim Williams]

Post a few sample rows of your new data.

 

[maperalia]

Tim;
Thank for your quick response.
Before I send you the data I wonder if you can tell me what these following
statements means in the macro you sent me:

If t <> "" Then
If IsNumeric(t) Then
c.Offset(0, 1).Value = t
Else
s = Right(t, 2)
c.Offset(0, Asc(s) - 95).Value = t
End If
End If

I would like to learn the interpretation so I will know how far I can modify
them.

Best regards.
Maperalia

 

[maperalia]

Tim;
This is the sample data that has error message:
73
74
75
76
81
82
83
84
89
90
91
2708
2709
2712
2713
2716
2717
2743
2744
2768
2769
1947A
2521A

I think that the capital letter that make the macro colapse.
Could you please check it.

Kind regads.
Maperalia

 

[Tim Williams]

1. If the value is a number then place it in the next column.
c.Offset(0, 1).Value = t

2. If the value is not numeric then get the last character (should be 1 not 2 there...)
s = Right(t, 1)

3. Convert the last character to a number based on its ASCII code ("a"=97, "A"=65)
Asc(s)

4. Convert the number to a column offset in order to place the value in the right column.
c.Offset(0, Asc(s) - 95).Value = t


So you just need to modify either the "97" or just do
Asc(lcase(s))
to convert your letters to lowercase before calculating the column offset

Tim

 

[maperalia]

Tim;
Thanks for the information. This will help me to understand better the
program. I really appreciatte your supporting with my project.

Kind regards.
Maperalia