What am I missing in this code?

[Brutusar]

I am using the code pasted in below to transpose a range. An example range is shown in row 133 in the minisheet below. The code produces the result shown in row 7-15.
I am trying to "expand" the code so I can adjust the number of columns to be transposed, from minimum 2 cols to maximum 10. Any good ideas on how to do that best? ( I can't get it to work at all)

This is the code I am using:

Sub Transpose()
    Dim Ary As Variant, Nary As Variant
    Dim r As Long, nr As Long, c As Long
   
    Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
    ReDim Nary(1 To UBound(Ary) * 5, 1 To 4)
    For r = 1 To UBound(Ary)
        For c = 5 To UBound(Ary, 2)
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, c)
        Next c
    Next r
    Sheets("Sheet1").Range("M1").Resize(nr, 3).Value = Nary
End Sub

Example.xlsx
	G
7
Sheet1

 

[Fluff]

That code will work for as many columns as exist, assuming there are no completely blank columns in the data.

 

[Brutusar]

Hi,

No, if I am using for instance 5 columns of numbers, as in the example, it only make 2 new rows, and uses the numbers in col E, F and G, skipping the numbers in col C and D. The picture below shows the result after I ran the code on the last range in the example

 

[Fluff]

If you need it to start in col 3 of the array use

For c = 3 To UBound(Ary, 2)

 

[Brutusar]

If you need it to start in col 3 of the array use

For c = 3 To UBound(Ary, 2)

Then the code run in to an error at: Nary(nr, 1) = Ary(r, 1) (Subscript out of range)

 

[Fluff]

In that case please post sample data using the XL2BB add-in.

 

[Marcelo Branco]

Maybe...

Sub aTest()
    Dim DataArr As Variant, ArrRes As Variant
    Dim r As Long, nr As Long, c As Long
  
    DataArr = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
    ReDim ArrRes(1 To UBound(DataArr, 1) * 3, 1 To 3)
    
    For r = 1 To UBound(DataArr, 1)
        For c = UBound(DataArr, 2) - 2 To UBound(DataArr, 2)
            nr = nr + 1
            ArrRes(nr, 1) = DataArr(r, 1)
            ArrRes(nr, 2) = DataArr(r, 2)
            ArrRes(nr, 3) = DataArr(r, c)
        Next c
    Next r
    Sheets("Sheet1").Range("M1").Resize(nr, 3).Value = ArrRes
End Sub

Hope this helps

M.

 

[Brutusar]

Maybe...

Sub aTest()
    Dim DataArr As Variant, ArrRes As Variant
    Dim r As Long, nr As Long, c As Long
 
    DataArr = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
    ReDim ArrRes(1 To UBound(DataArr, 1) * 3, 1 To 3)
   
    For r = 1 To UBound(DataArr, 1)
        For c = UBound(DataArr, 2) - 2 To UBound(DataArr, 2)
            nr = nr + 1
            ArrRes(nr, 1) = DataArr(r, 1)
            ArrRes(nr, 2) = DataArr(r, 2)
            ArrRes(nr, 3) = DataArr(r, c)
        Next c
    Next r
    Sheets("Sheet1").Range("M1").Resize(nr, 3).Value = ArrRes
End Sub

Hope this helps

M.

Hi, still get a error message, no idea why. It is two columns with text and then 3-5 colums with numbers. When I tested it now it was text in col A and B, and numbers in col C, D and E.

 

[Marcelo Branco]

Hi, still get a error message, no idea why. It is two columns with text and then 3-5 colums with numbers. When I tested it now it was text in col A and B, and numbers in col C, D and E.

The code worked perfectly for me

Test 1
Data in A1:E3 (with 3 numbers)
Result

Pasta1
	M	N	O
1	New York	Los Angeles	450
2	New York	Los Angeles	900
3	New York	Los Angeles	900
4	Orlando	Houston	1610
5	Orlando	Houston	2220
6	Orlando	Houston	2220
7	Miami	Las Vegas	2300
8	Miami	Las Vegas	2700
9	Miami	Las Vegas	2700
Sheet1

Test 2 (with 5 numbers)
Data in A1:G3 (with 5 numbers)
Result

Pasta1
	M	N	O
1	New York	Los Angeles	900
2	New York	Los Angeles	1100
3	New York	Los Angeles	1700
4	Orlando	Houston	2220
5	Orlando	Houston	2300
6	Orlando	Houston	2500
7	Miami	Las Vegas	2700
8	Miami	Las Vegas	2900
9	Miami	Las Vegas	3000
Sheet1

M.

 

[Brutusar]

I think I have an issue with Excel. When cells shows as empty, they are not really empty, and maybe that causes the problem. If I am automating data entry into Excel, and has set the code to write data into "first empty row", it may start entering data into for instance row 34, even if there are no visible data in the rows before. This causes the code to brake. If I pause the code at that point, manually delete the rows over the first entered row, and then continue to run the code, it works fine.