How to do multiple transpose in excel vba

[nagasree]

I have a list of items which are scattered, I need them all in one column, the items scattered can be brought into one column withing the blank cells.

This is what i need. some times there is 2 values to transpose, sometimes 5 or sometimes no need, So i dont know how to achieve it.

Sub Transpose_Example1()

Range("D1:H2").Value = WorksheetFunction.Transpose(Range("A1:D5"))

End Sub

This is the code i found for transpose but here range is fixed, I need to achive the above in one click, So someone please help me

 

[offthelip]

try this:

Sub test3()
  Dim outarr()
  Nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  inarr = Range(Cells(1, 1), Cells(lr, Nc))
  ReDim outarr(1 To lr * Nc, 1 To 1)
    indi = 1
    For i = 1 To UBound(inarr, 1)
        For j = 1 To UBound(inarr, 2)
            If inarr(i, j) <> "" Then
             outarr(indi, 1) = inarr(i, j)
             indi = indi + 1
            End If
        Next j
   Next i
  Range(Cells(1, Nc + 1), Cells(indi - 1, Nc + 1)) = outarr
End Sub

 

[alansidman]

Load your data to Power Query Editor and then Unpivot your data and remove null rows.

 

[nagasree]

try this:

Sub test3()
  Dim outarr()
  Nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  inarr = Range(Cells(1, 1), Cells(lr, Nc))
  ReDim outarr(1 To lr * Nc, 1 To 1)
    indi = 1
    For i = 1 To UBound(inarr, 1)
        For j = 1 To UBound(inarr, 2)
            If inarr(i, j) <> "" Then
             outarr(indi, 1) = inarr(i, j)
             indi = indi + 1
            End If
        Next j
   Next i
  Range(Cells(1, Nc + 1), Cells(indi - 1, Nc + 1)) = outarr
End Sub

Hi, thanks for the help, this works but, the values in items must not change, for example, if grapes in not present then the order must be apple, orange, blank row, red, blue, and so on, is this possible

 

[offthelip]

You could try deleting this line:


If inarr(i, j) <> "" Then
and the ending which will keep all the blank cells

 

[alansidman]

Power Query Mcode

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(Source, {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"})
in
    #"Removed Columns"

Book4
	A	B	C	D	E	F
1	Column1	Column2	Column3	Column4		Value
2	apple	orange	grapes			apple
3						orange
4						grapes
5	red	Blue				red
6						Blue
7	Green					Green
8	Yellow	Rose				Yellow
9						Rose
10	Pink	White	Grey	Black		Pink
11						White
12						Grey
13						Black
14	Monday					Monday
15	Tuesday					Tuesday
16	Wednesday	Thursday				Wednesday
17						Thursday
18	Friday					Friday
Sheet1