Previous Topic Next Topic

Transpose data from vertical to horizontal

Solved/Closed
Report
Posts
72
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 3, 2021
 -
Posts
72
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 3, 2021
 -
Hello,
this the code doesn't work i would transpose as what in existed in picture the result from e: h i hope somebody help me 

Sub VerticalToHorizontal()
  Dim a As Variant, b As Variant
  Dim RowsPerBlock As Long, NumBlocks As Long, i As Long, j As Long, BaseNum As Long
  
  RowsPerBlock = Columns(1).Find(What:=Range("A1").Value, LookAt:=xlWhole).Row - 1
  
  '*** RowsPerBlock will =1 if A1 is empty  or 
  '*** it will = 0 if A1 is the only cell in the column with data

  If RowsPerBlock = 0 Or Range("A1") = "" Then
    Exit Sub
  End If

  a = Range("B1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  NumBlocks = UBound(a) / RowsPerBlock
  ReDim b(1 To NumBlocks, 1 To RowsPerBlock)
  Do Until i = NumBlocks
    i = i + 1
    BaseNum = (i - 1) * RowsPerBlock
    For j = 1 To RowsPerBlock
      b(i, j) = a(BaseNum + j, 1)
    Next j
  Loop
  With Range("e1").Resize(, RowsPerBlock)
    .Value = Application.Transpose(Range("A1").Resize(RowsPerBlock).Value)
    .Offset(1).Resize(NumBlocks).Value = b
  End With
End Sub

2 replies

Answer 1 / 2
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
 490
Hi Abdel,

Your code doesn't make much sense to me. RowsPerBlock will always be 0, since the value of A1 will always be found on the first row of the first column. And when it is 0, the code ends ....

So I took the liberty to write my own code. I hope you don't mind ;).

Here is the code: 
Sub RunMe()
Dim lRow, lCol, x As Integer

lRow = Range("A1").End(xlDown).Row
lCol = Range("A1").End(xlToRight).Column

For Each cell In Range(Cells(1, 1), Cells(1, lCol))
    x = x + 1
    Range(Cells(1, cell.Column), Cells(lRow, cell.Column)).Copy
    Cells(x, lCol + 2).PasteSpecial Transpose:=True
Next cell
Application.CutCopyMode = False
End Sub


Best regards,
Trowa

1
Thank you
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2821 users have said thank you to us this month

Report
Posts
72
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 3, 2021
hi, Trowa
first of all this code is not original it was existed error somebody try fix the error by this RowsPerBlock always be 0
it doesn't solve my problem the secondly i don't mind if is solve my problem your code is nice but i think you should fix as my image in column e it supposes doesn't show and i would dynamically transpose data maybe i have many brands i'm talking about from col a,b maybe data also in col c,d,e..etc
Answer 2 / 2
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
 490
Hi Abdel,

Ok, I added a line to clear the transposed data. When you want to add another column of data, right-click the empty column between original and transposed data (so column D for the first extra data column) and insert a column (to keep an empty column between original and transposed data), enter your data and run the code again to update (actually create new) the transposed data.

Here is the updated code: 
Sub RunMe()
Dim lRow, lCol, x As Integer

lRow = Range("A1").End(xlDown).Row
lCol = Range("A1").End(xlToRight).Column

Cells(1, lCol + 2).CurrentRegion.ClearContents

For Each cell In Range(Cells(1, 1), Cells(1, lCol))
    x = x + 1
    Range(Cells(1, cell.Column), Cells(lRow, cell.Column)).Copy
    Cells(x, lCol + 2).PasteSpecial Transpose:=True
Next cell
Application.CutCopyMode = False
End Sub


PS: When you remove a column of data, you will want to run the code twice to get correct transposed data.

Best regards,
Trowa
Report
Posts
72
Registration date
Thursday July 18, 2019
Status
Member
Last seen
November 3, 2021
i noted if there is no empty col between orginal data and transpose data it transposes data to a new cols and copy data incorrectly and if i insert empty col between them it works very well even if i adjust original data .
thanks Trowa for this code it works very well
Ask a question