Splitting one column into multiple columns

[paintermonkey]

I have a column of text (non-numeric) data that I want to split into
multiple columns whenever the same text appears. What I mean is:

I have:

Title
Info1
Info2
Info3
Info4
Title
Info5
Info6
Info7
Info8
Title
Info9

I want to change that to:

Title Title Title
Info1 Info5 Info9
Info2 Info6
Info3 Info7
Info4 Info8


Ultimately, I will then delete the lower rows of information straight
across the board. Leaving me with:

Title Title Title
Info1 Info5 Info9
Info2 Info6


The "title" is always the same phrase/content.


Is there a macro or VBA code I can use to accomplish this?

Thanks in advance,

PM

 

[Toppers]

Try:

Sub a()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long, sr As Long
Dim orng As Range

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

Set orng = ws2.Cells(1, 1)

r = 1
With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Title = "Title" '<=== Change as required
Do
sr = r
Do
r = r + 1
Loop Until .Cells(r, 1) = Title Or r > lastrow
orng = .Cells(sr, 1)
.Cells(sr + 1, 1).Resize(r - sr - 1, 1).Copy orng.Offset(1, 0)
Set orng = orng.Offset(0, 1)
Loop Until r > lastrow
End With

End Sub

 

[Painter]

Thanks Toppers,

However, this presented a problem (runtime error 1004):

..Cells(sr + 1, 1).Resize(r - sr - 1, 1).Copy orng.Offset(1, 0)

Did I forget to customize something?

PM

 

[Painter]

I've tried modifying the code but then it doesn't seem to affect the
worksheet at all. What can I be doing wrong?

 

[Painter]

I've tried modifying the code but then it doesn't seem to affect the
worksheet at all. What can I be doing wrong?

 

[Herbert Seidenberg]

Here is a non-VBA solution.
Add a helper column and row to make it look like this:

Seq Title 1 10 16 20 23 Ttab
1 A_1 A_1 B_1 C_1 D_1
2 A_2 A_2 B_2 C_2 D_2
3 A_3 A_3 B_3 C_3
4 A_4 A_4 B_4
5 A_5 A_5 B_5
6 A_6 A_6
7 A_7 A_7
8 A_8 A_8
9 Title
10 B_1
11 B_2
12 B_3
13 B_4
14 B_5
15 Title
16 C_1
17 C_2
18 C_3
19 Title
20 D_1
21 D_2

Name the numbers in the first column (1 thru 21) Seq
Name the numbers in the first row (1, 10, 16, 20, 23) TTab
Name your data MyData
The first cell of TTab =1
The last cell of TTab has the formula
=ROWS(MyData)+1
The other cells of TTab have this formula
=MATCH("Title",INDEX(MyData,Ttab C[-1]+1):
INDEX(MyData,ROWS(MyData)),0)+Ttab C[-1]
Fill the remaining 23x4 array with
=IF((Ttab+Seq)<Ttab C[1],INDEX(MyData,Ttab+Seq),"")
The above formulas are in R1C1 Ref Style.
Uncheck this option, if desired, after final data entry.

 

[Toppers]

Can you post your code please.

 

[Painter]

Thanks Herbert,

I will give this a try. But also know that there are roughly 60,000
rows of information I'm trying to sort out in this spreadsheet.

PM

 

[Herbert Seidenberg]

There are lots of tricks to handle big data.
For example to fill the seq column,
just fill in the first few numbers and then
double click the fill handle.
The helper column can also be eliminated
at the expense of formula complexity.
Let me know what would help you most.