Showing columns data in row

[max4asd]

Hi,


Required a help on showing columns data in rows.


Example.

Van No. Customer No Exp%

1100 1100000111 1.48%

1100 1100000116 5.51%

1100 1100000120 6.39%

1100 1100000123 9.94%

1100 1100000127 11.44%

1101 1100000125 20.83%

1101 1100000137 27.60%

1101 1100000138 15.26%

1101 1100000139 19.17%

1101 1100000141 7.90%

1101 1100000233 0.50%

1102 1100000114 9.05%

1102 1100000117 4.37%

1102 1100000130 16.05%

1102 1100000131 1.10%

1102 1100000132 6.37%

1103 1100001627 6.58%

1103 1100001629 0.75%

1103 1100001635 4.91%

1103 1100001642 8.25%

1103 1100001645 1.21%

1104 1100000319 14.76%

1104 1100000937 3.25%

1104 1100000939 0.00%

1104 1100000941 1.27%

1104 1100000942 3.10%

1105 1100000825 2.19%

1105 1100000826 8.86%

1105 1100000829 45.21%

1105 1100000830 21.19%

1105 1100000831 9.85%


The out put should be in below format


Van No. Customer No

1100 1100000111 1100000116 1100000120 1100000123

1100 Total 1.48% 5.51% 6.39% 9.94%

1101 1100000125 1100000137 1100000138 1100000139

1101 Total 20.83% 27.60% 15.26% 19.17%

1102 1100000114 1100000117 1100000130 1100000131

1102 Total 9.05% 4.37% 16.05% 1.10%

1103 1100001627 1100001629 1100001635 1100001642

1103 Total 6.58% 0.75% 4.91% 8.25%

1104 1100000319 1100000937 1100000939 1100000941

1104 Total 14.76% 3.25% 1.27%

1105 1100000825 1100000826 1100000829 1100000830

1105 Total 2.19% 8.86% 45.21% 21.19%

 

[Hui]

Max4asd

I have put a subroutine below which will do what you want


Copy and paste it into the VBA code page for the sheet you are working on

ie: Alt F11, select your worksheet, paste in the open area on the right

Run the code as is


It will put a new table in Column E starting at Row 2

[pre]

Sub TextRearrange()

Row = 2
j = 2
k = 5

Do While Cells(Row, 1).Value <> ""
With Activesheet

If k = 5 Then
.Cells(j, k).Value = .Cells(Row, 1).Value
.Cells(j, k).NumberFormat = "0"

.Cells(j + 1, k).Value = .Cells(Row, 1).Value
.Cells(j + 1, k).NumberFormat = "0"
End If

.Cells(j, k + 1).Value = .Cells(Row, 2).Value
.Cells(j, k + 1).NumberFormat = "0"

.Cells(j + 1, k + 1).Value = .Cells(Row, 3).Value
.Cells(j + 1, k + 1).NumberFormat = "0.00%"

If .Cells(Row, 1).Value <> .Cells(Row + 1, 1).Value Then
Row = Row + 1
j = j + 2
k = 5
Else
Row = Row + 1
k = k + 1
End If

End With
Loop

End Sub

[/pre]

 

[max4asd]

Thanks a lot Hui Its great to have such quick solution outstanding .


Could you please also eloborate the script step by step more so that i can do it my self

 

[max4asd]

Thanks a lot Hui for great help but just help me if i have one more column of information then how should i update the subroutine script to display in the same way as its doing with 3 columns of data.


Thanking you in advance

 

[Hui]

This will handle 4 Columns of data

[pre]

Sub TextRearrange()
Dim Row As Long, j As Long, sr As Long, k As Long, nc As Long

Row = 2
j = 2 'Start Row of Storage Area
sr = 10 'Start Column of Storage Area
nc = 3 'No. of Data Columns
k = sr

Do While Cells(Row, 1).Value <> ""
With ActiveSheet

If k = sr Then
.Cells(j, k).Value = .Cells(Row, 1).Value
.Cells(j, k).NumberFormat = "0"

.Cells(j + 1, k).Value = .Cells(Row, 1).Value
.Cells(j + 1, k).NumberFormat = "0"

.Cells(j + 2, k).Value = .Cells(Row, 1).Value
.Cells(j + 2, k).NumberFormat = "0"

End If

.Cells(j, k + 1).Value = .Cells(Row, 2).Value
.Cells(j, k + 1).NumberFormat = "0"

.Cells(j + 1, k + 1).Value = .Cells(Row, 3).Value
.Cells(j + 1, k + 1).NumberFormat = "0.00%"

.Cells(j + 2, k + 1).Value = .Cells(Row, 4).Value
.Cells(j + 2, k + 1).NumberFormat = "0"

If .Cells(Row, 1).Value <> .Cells(Row + 1, 1).Value Then
Row = Row + 1
j = j + nc
k = sr
Else
Row = Row + 1
k = k + 1
End If

End With
Loop

End Sub

[/pre]

I will document this when time permits