SEPARATE LARGE COLUMN INTO 4 COLUMNS

[rikvny02]

I have a large list of addresses in column "A". I would like to separate them into 4 columns. Each address is separated by a blank row. The main issue occurs when an address has 4 lines of data instead of 3. Everything gets shifted. I have tried an offset formula and also the WRAPROWS formula. I can't seem to get past the forth row of data. Can someone help? Maybe this can be solved easier with a loop in which starts back at Column "C" after each blank row. please see the below example.

 

[MARK858]

Try the code below (only tested on random data)

Sub rikvny02()
    Dim myCell As Range
    Application.ScreenUpdating = False
  
    For Each myCell In Columns(1).SpecialCells(2).Areas
        Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, myCell.Rows.Count).Value = Application.Transpose(myCell.Value)
    Next myCell
  
End Sub

 

[MARK858]

Amended as the data starts in row 3

Sub rikvny02B()
    Dim myCell As Range
    Application.ScreenUpdating = False
  
    For Each myCell In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(2).Areas
        Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, myCell.Rows.Count).Value = Application.Transpose(myCell.Value)
    Next myCell
  
End Sub

 

[Cubist]

Here's a formula option. Try:

Book1
	A	B	C	D	E	F
1
2
3	Name1		Name1	Street1	Address1
4	Street1		Name2	Street2	Address2
5	Address1		Name3	ATT:3	Street3	Address3
6			Name4	Street4	Address4
7	Name2
8	Street2
9	Address2
10
11	Name3
12	ATT:3
13	Street3
14	Address3
15
16	Name4
17	Street4
18	Address4
Sheet9

Cell Formulas
Range	Formula
C3:F6	C3	=LET( data,A3:A18, r,SCAN(1,data,LAMBDA(a,b,IF(b<>"",a,a+1))), c,SCAN(0,data,LAMBDA(a,b,IF(b<>"",a+1,0))), IFNA(INDEX(data,XMATCH(SEQUENCE(MAX(r))&"|"&SEQUENCE(,MAX(c)),r&"|"&c)),"") )
Dynamic array formulas.

 

[rikvny02]

Amended as the data starts in row 3

Sub rikvny02B()
    Dim myCell As Range
    Application.ScreenUpdating = False
 
    For Each myCell In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(2).Areas
        Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, myCell.Rows.Count).Value = Application.Transpose(myCell.Value)
    Next myCell
 
End Sub

The results continue transposing the address horizontal across (ex. columns "G:XFD) the sheet. I would expect it to continue vertical starting in column "c".

 

[MARK858]

The results continue transposing the address horizontal across (ex. columns "G:XFD) the sheet. I would expect it to continue vertical starting in column "c".

Then your cells aren't truly blank/empty if you used the code in post 3

With

Test Workbook .xlsb
	A	B	C	D	E
1	Address
2
3	7996 Support Ln SE
4	7997 Support Ln SE
5
6	8336 Engine Avenue NW
7	311 Partner Street
8	508 Sugar Ave
9	5189 Loss Street
10	2501 Dinosaur Avenue
11	8109 Hydrant St E
12
13	277 Push Avenue
14	877 Authority Lane
15	164 Sofa Lane
16
17	948 Melon Ln N
18	566 Lip Boulevard
19	19 Glass Ln
20	9608 Bubble Street E
21	743 Memory St
22	3605 Icicle Lane
23	561 Reward Ln
24
25	954 Yard Boulevard
26	2368 Copper Lane SE
27	685 Mom Avenue
28
29	993 Rest Street
30	932 Toothpaste Ln
31	831 Fig Ave NW
32	5302 Sun Street
Sheet9

The code produces the below with the code posted

Test Workbook .xlsb
	A	B	C	D	E	F	G	H	I
1	Address
2			7996 Support Ln SE	7997 Support Ln SE
3	7996 Support Ln SE		8336 Engine Avenue NW	311 Partner Street	508 Sugar Ave	5189 Loss Street	2501 Dinosaur Avenue	8109 Hydrant St E
4	7997 Support Ln SE		277 Push Avenue	877 Authority Lane	164 Sofa Lane
5			948 Melon Ln N	566 Lip Boulevard	19 Glass Ln	9608 Bubble Street E	743 Memory St	3605 Icicle Lane	561 Reward Ln
6	8336 Engine Avenue NW		954 Yard Boulevard	2368 Copper Lane SE	685 Mom Avenue
7	311 Partner Street		993 Rest Street	932 Toothpaste Ln	831 Fig Ave NW	5302 Sun Street
8	508 Sugar Ave
9	5189 Loss Street
10	2501 Dinosaur Avenue
11	8109 Hydrant St E
12
13	277 Push Avenue
14	877 Authority Lane
15	164 Sofa Lane
16
17	948 Melon Ln N
18	566 Lip Boulevard
19	19 Glass Ln
20	9608 Bubble Street E
21	743 Memory St
22	3605 Icicle Lane
23	561 Reward Ln
24
25	954 Yard Boulevard
26	2368 Copper Lane SE
27	685 Mom Avenue
28
29	993 Rest Street
30	932 Toothpaste Ln
31	831 Fig Ave NW
32	5302 Sun Street
Sheet9

or

Test Workbook .xlsb
	A
1	Address
2
3	a
4	b
5
6	c
7	d
8	e
9	f
10	g
11	h
12
13	i
14	j
15	k
16
17	l
18	m
19	n
20	o
21	p
22	q
23	r
24	s
25	t
26	u
27	v
28
29	w
30	x
31	y
32	z
Sheet9

Results in

Test Workbook .xlsb
	A	B	C	D	E	F	G	H	I	J	K	L
1	Address
2			a	b
3	a		c	d	e	f	g	h
4	b		i	j	k
5			l	m	n	o	p	q	r	s	t	u
6	c		w	x	y	z
7	d
8	e
9	f
10	g
11	h
12
13	i
14	j
15	k
16
17	l
18	m
19	n
20	o
21	p
22	q
23	r
24	s
25	t
26	u
27	v
28
29	w
30	x
31	y
32	z
Sheet9

 

[rikvny02]

INCREDIBLE. Thank you.

 

[rikvny02]

I wish we could mark more than one post as the solution. Your formula works perfectly. Thank you.

An option for formula solution and macro solution I think would be very helpful to all.

 

[MARK858]

I wish we could mark more than one post as the solution

Mark whichever one you actually use

 

[rikvny02]

Amended as the data starts in row 3

Sub rikvny02B()
    Dim myCell As Range
    Application.ScreenUpdating = False
 
    For Each myCell In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(2).Areas
        Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, myCell.Rows.Count).Value = Application.Transpose(myCell.Value)
    Next myCell
 
End Sub
[/CODE
[/QUOTE]
incredible thank you

@

MARK858 you solution works great. Thank you​