Moving Column Into Rows

Closed
John - Nov 1, 2010 at 09:49 AM
venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
- Nov 2, 2010 at 11:25 PM
Hi

I'm preparing weekly sales report on category sold per shoping chart. There are 100 categories (Category will be header) and all the data extract well be as 'Sheet 1 - Input Data'. The out put of the report should look like 'Sheet2 - OutPut Data'

The report should be generic in such a way the categories is n

Sheet 1 - Input Data

Shoping Cart# Category 1 Category 2 Category 3 Category 4 Category n 10004270 10 100 1000 10000
10000437 9 99 999
10000234 55555 5555 555 5

Sheet2 - OutPut Data

Shoping Cart# Category Value
10004270 Category 1 10
10004270 Category 2 100
10004270 Category 3 1000
10004270 Category 4 10000
10000437 Category 1 9
10000437 Category 2 99
10000437 Category 4 999
10000234 Category 1 55555
10000234 Category 2 5555
10000234 Category 3 555
10000234 Category n 5

I know you guyz are guru in Macros and Excel VB scripting. Please help me in solving this report.

Kind Regards
John

1 reply

venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
810
Nov 2, 2010 at 11:25 PM
try this macro
the main data is in sheet 1
the result is in sheet 2

the macro is

Sub TEST()
Dim r As Range, c As Range, j As Long, k As Long
Dim dest As Range, x(1 To 3) As String, m As Long
Worksheets("sheet2").Cells.Clear
Worksheets("sheet1").Activate
j = Range("A1").End(xlToRight).Column
Set r = Range(Range("A2"), Range("A2").End(xlDown))
For Each c In r
For k = 1 To j - 1
x(1) = Cells(c.Row, 1).Value
x(2) = Cells(1, k + 1).Value
x(3) = Cells(c.Row, k + 1).Value
'MsgBox x(1) & "," & x(2) & "," & x(3)
If Cells(c.Row, k + 1) = "" Then GoTo line1
Set dest = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Set dest = Range(dest, dest.Offset(0, 2))
dest = x
line1:
Next k
Next c
End Sub
0