VBA Macro to transpose Data

[ascool_asice]

Hi,

I was wondering if someone could help me out with a macro to transform my data from Columns to Rows.

From

Help.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	Stock Item Name	Category1	Category2	Category3	Category4	Category5	Category6	Category7	Category8	Category9	Category10	Category11	Category12	Category13	Category14	Category15	Category16	Category17	Category18	Category19	Category20	Category21	Category22	Category23	Category24	Category25
2	A	AB-10	BC20
3	B	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25
4	C			E
5	D	AB-10	BC20	CD	EF	GH	IJ
6	F
From

Output should look like

Help.xlsx
	A	B
1	Stock Item Name	Category
2	A	AB-10
3	A	BC20
4	B	1
5	B	2
6	B	3
7	B	4
8	B	5
9	B	6
10	B	7
11	B	8
12	B	9
13	B	10
14	B	11
15	B	12
16	B	13
17	B	14
18	B	15
19	B	16
20	B	17
21	B	18
22	B	19
23	B	20
24	B	21
25	B	22
26	B	23
27	B	24
28	B	25
29	C	E
30	D	AB-10
31	D	BC20
32	D	CD
33	D	EF
34	D	GH
35	D	IJ
36	F
Transposed

 

[DanteAmor]

Try this:

Sub Transpose_Data()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  a = Sheets("From").Range("A1").CurrentRegion
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 2)
  
  k = 1
  For i = 2 To UBound(a, 1)
    For j = 2 To UBound(a, 2)
      b(k, 1) = a(i, 1)
      If a(i, j) <> "" Then
        b(k, 2) = a(i, j)
        k = k + 1
      End If
    Next
  Next
  Sheets("Transposed").Range("A2").Resize(k, 2).Value = b
End Sub

 

[ascool_asice]

Hi DanteAmor,

Thank you so much this works like a charm. Truly appreciate your time and effort

 

[ascool_asice]

The data was a little large so took me a little time to realize that there seems to be some problem it's leaving out a few entries. See below the result

From

Tally-01 - Final.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	Stock Item Name	Category1	Category2	Category3	Category4	Category5	Category6	Category7	Category8	Category9	Category10	Category11	Category12	Category13	Category14	Category15	Category16	Category17	Category18	Category19	Category20	Category21	Category22	Category23	Category24	Category25
2	A	AB-10	BC20
3	B	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25
4	C			E
5	D	AB-10	BC20	CD	EF	GH	IJ
6	F
7	G
8	H
9	I
10	J
11	K
From

Transposed. (F,G,H,I & J are missing)

Tally-01 - Final.xlsx
	A	B
1	Stock Item Name	Category
2	A	AB-10
3	A	BC20
4	B	1
5	B	2
6	B	3
7	B	4
8	B	5
9	B	6
10	B	7
11	B	8
12	B	9
13	B	10
14	B	11
15	B	12
16	B	13
17	B	14
18	B	15
19	B	16
20	B	17
21	B	18
22	B	19
23	B	20
24	B	21
25	B	22
26	B	23
27	B	24
28	B	25
29	C	E
30	D	AB-10
31	D	BC20
32	D	CD
33	D	EF
34	D	GH
35	D	IJ
36	K
Transposed

 

[DanteAmor]

Try this:

Sub Transpose_Data()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  Dim bln As Boolean
  
  a = Sheets("From").Range("A1").CurrentRegion
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 2)
  
  k = 1
  For i = 2 To UBound(a, 1)
    bln = False
    For j = 2 To UBound(a, 2)
      b(k, 1) = a(i, 1)
      If a(i, j) <> "" Then
        b(k, 2) = a(i, j)
        k = k + 1
        bln = True
      End If
    Next
    If bln = False Then k = k + 1
  Next
  Sheets("Transposed").Range("A2").Resize(k, 2).Value = b
End Sub