Transposing a Horizontal Letter Sequence into a Vertical Letter Sequence

[rwmill9716]

I have converted the words in Column D into a horizontal list of letters (Cols F-N). I need a macro that builds a continuous vertical listing of these letters (Col B). In my Excel sheet there are hundreds of words.

Splitting Words.xlsx
	B	C	D	E	F	G	H	I	J	K	L	M	N
19			Words		1	2	3	4	5	6	7	8	9
20	i		in		i	n
21	n		the		t	h	e
22	t		beginning		b	e	g	i	n	n	i	n	g
23	h		god		g	o	d
24	e		created		c	r	e	a	t	e	d
25	b		the		t	h	e
26	e		heaven		h	e	a	v	e	n
27	g		and		a	n	d
28	i		the		t	h	e
29	n		earth		e	a	r	t	h
30	n		and		a	n	d
31	i		the		t	h	e
32	n		earth		e	a	r	t	h
33	g		was		w	a	s
Genesis

Cell Formulas
Range	Formula
F20:N33	F20	=MID($D20,COLUMNS($D$20:D$20),1)
B20	B20	=MID($D20,COLUMNS($D$20:D$20),1)
B21	B21	=MID($D20,COLUMNS($D$20:E$20),1)
B22	B22	=MID($D21,COLUMNS($D$20:D$20),1)
B23	B23	=MID($D21,COLUMNS($D$20:E$20),1)
B24	B24	=MID($D21,COLUMNS($D$20:F$20),1)
B25	B25	=MID($D22,COLUMNS($D$20:D$20),1)
B26	B26	=MID($D22,COLUMNS($D$20:E$20),1)
B27	B27	=MID($D22,COLUMNS($D$20:F$20),1)
B28	B28	=MID($D22,COLUMNS($D$20:G$20),1)
B29	B29	=MID($D22,COLUMNS($D$20:H$20),1)
B30	B30	=MID($D22,COLUMNS($D$20:I$20),1)
B31	B31	=MID($D22,COLUMNS($D$20:J$20),1)
B32	B32	=MID($D22,COLUMNS($D$20:K$20),1)
B33	B33	=MID($D22,COLUMNS($D$20:L$20),1)

 

[DanteAmor]

Try this:

Sub Transposing_Horizontal_Letter()
  Dim c As Range
  Dim i As Long, j As Long
 
  i = 20
  For Each c In Range("D20", Range("D" & Rows.Count).End(3))
    For j = 1 To Len(c.Value)
      Range("A" & i).Value = Mid(c.Value, j, 1)
      i = i + 1
    Next
  Next
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[rwmill9716]

Try this:

Sub Transposing_Horizontal_Letter()
  Dim c As Range
  Dim i As Long, j As Long
 
  i = 20
  For Each c In Range("D20", Range("D" & Rows.Count).End(3))
    For j = 1 To Len(c.Value)
      Range("A" & i).Value = Mid(c.Value, j, 1)
      i = i + 1
    Next
  Next
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

Thanks, Dante, that does exactly what I wanted it to

 

[Rick Rothstein]

Just noting that the macro to do this can do it without using a loop...

Sub Transposing_Horizontal_Letter()
  Dim V As Variant
  V = Split(StrConv(Join(Application.Transpose(Range("D20", Cells(Rows.Count, "D").End(xlUp)).Value), ""), vbUnicode), Chr(0))
  Range("A20").Resize(UBound(V)) = Application.Transpose(V)
End Sub

 

[rwmill9716]

Just noting that the macro to do this can do it without using a loop...

Sub Transposing_Horizontal_Letter()
  Dim V As Variant
  V = Split(StrConv(Join(Application.Transpose(Range("D20", Cells(Rows.Count, "D").End(xlUp)).Value), ""), vbUnicode), Chr(0))
  Range("A20").Resize(UBound(V)) = Application.Transpose(V)
End Sub

Thanks, Rick, this works well too.