Transpose and sort columns in to rows

elektor · Jun 18, 2011

I need a vba excel macro to transpose and sort columns in to rows.
Saple file before transpose:
Sheet 1

------B----------------------C------------------D--------------------E----------------F--------------------G
3----Stock Number-- ------Product ----------Units---------------Room----------Available----------Sum

4----PE22------------------Pen---------------- Pieces ------------R09-------------6---------------------11
5--------------------------------------------------------------------R01-------------3
6--------------------------------------------------------------------R22-------------2
7 Blank row
8----PE25---------------------Pencil-------------- Pieces --------------------------------------------------------
9----C13----------------------Chair----------------Pieces---------R22-------------3----------------------10
10-------------------------------------------------------------------R05-------------2
11-------------------------------------------------------------------R04-------------3
12-------------------------------------------------------------------R01-------------2
13---T05----------------------Computer-----------Pieces---------R02-------------1-----------------------1
14 Blank row
15 Blank row

Note: There are tens of thousands of lines, thousands of products, hundreds of rooms.

Output samle file:
Sheet2

----A --------------B-----------------C----------D--------E------F-------G-------H------I-------J------K
4---Line Nmr.---Stock Nmr.--------Product---Units----R01---R02----R04----R05---R09--- R22-- Sum
5---1-------------- PE22------------ Pen------- Pieces---3------------------------------6------2------11
6---2-------------- C13--------------Chair----- Pieces---2--------------3--------2-------------3------10
7---3-------------- T05-------------Computer- Pieces-----------1---------------------------------------1

Note 1: Pencil doesn’t transpose to sheet2. Because there isn’t any pencil in any room.
Note 2 : The rooms must be sorted.

Any help would be most appreciated!

MickG · Jun 18, 2011

Try this :-
Results sheet (2) start "A1".

Code:

[COLOR="Navy"]Sub[/COLOR] MG18Jun36
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Room [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B4"), Range("B" & rows.Count).End(xlUp))
  ReDim ray(1 To Rng.Count, 1 To 10)
     Room = Array("Stock Number", "Product", "Units", "R01", "R02", "R04", "R05", "R09", "R022", "Sum")
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(Room)
    ray(1, n + 1) = Room(n)
[COLOR="Navy"]Next[/COLOR] n
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Dn <> "" And Dn(, 4) <> "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Room)
        [COLOR="Navy"]If[/COLOR] Room(n) = Dn(, 4) [COLOR="Navy"]Then[/COLOR] Col = n + 1: [COLOR="Navy"]Exit[/COLOR] For
    [COLOR="Navy"]Next[/COLOR] n
        c = c + 1
        ray(c, 1) = Dn: ray(c, 2) = Dn(, 2): ray(c, 3) = Dn(, 3): ray(c, Col) = Dn(, 5):
        [COLOR="Navy"]If[/COLOR] Dn(, 6) <> "" [COLOR="Navy"]Then[/COLOR] ray(c, 10) = Dn(, 6)
[COLOR="Navy"]ElseIf[/COLOR] Dn = "" And Dn(, 4) <> "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Room)
        [COLOR="Navy"]If[/COLOR] Room(n) = Dn(, 4) [COLOR="Navy"]Then[/COLOR] Col = n + 1: [COLOR="Navy"]Exit[/COLOR] For
    [COLOR="Navy"]Next[/COLOR] n
        ray(c, Col) = Dn(, 5):
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Sheets("sheet2").Range("A1").Resize(c, 10) = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

elektor · Jun 18, 2011

Thanks for your help MickG.
As I noted, there are hundreds of rooms Like R01, R02,….R88, Firs Floor WC, Stokehold, Rest area, Generator room, garden etc. Rooms must be dynamic.

MickG · Jun 18, 2011

Diid the code work for the Example data, It was quite difficult rearranging your data. (see below)
If the basic code worked I think I can get the rooms that appear in column "Room" dynamically.
I would like to know if the basics are correct before proceeding

You should be able to post your data in abetter format..
If you look at this, Something "Andrew Poulson Kindly Noted"

Just copy part of your worksheet and paste it into a reply. You need to select 'Enhanced Interface - Full WYSIWYG Editing' in 'Message Editor Interface' under User CP|Edit Options (menu towards top of screen on Board).

NB:-You may find you need to place a border around each cell (to form a grid) in the range you wish to copy to the Thread.

elektor · Jun 18, 2011

Excel Workbook
A B C D E F G
1 R. N. Stock Number Product Units Room Available Sum
2
3 P25 Pencil Pieces
4 1 P45 Pen Pieces Room 05 1 1
5 2 C135 Computer Pieces Room 01 1 5
6 Room 03 2
7 Room 88 1
8 Penthouse 1
9 T18 Table Pieces
10 3 T22 TV Pieces Room 03 1 5
11 Room 01 2
12 Rest area 2
13
14
15
16 4 T35 Telephone Pieces Room 65 2 6
17 Room 03 3
18 Room 04 1
19
20 5 B84 Boiler Pieces Stokehole 1 1
21 P43 Plotter Pieces
22
23
24 6 P18 Printer Pieces Room 01 1 1
25 7 D04 Dryer Pieces Laundry 2 2
26 Sheet1 Sample Data Sheet
27 There are tens of thousands of lines, thousands of products, hundreds of rooms.
Sheet1

Excel Workbook
A B C D E F G H I J K L M N O
1 Row Number Stock Number Product Units Laundry Penthouse Rest area Room 01 Room 03 Room 04 Room 05 Room 65 Room 88 Stokehole SUM
2
3 1 P45 Pen Pcs. 1 1
4 2 C135 Computer Pcs. 1 1 2 1 5
5 3 T22 TV Pcs. 2 2 1 5
6 4 T35 Telephone Pcs. 3 1 2 6
7 5 B84 Boiler Pcs. 1 1
8 6 P18 Printer Pcs. 1 1
9 7 D04 Dryer Pcs. 2 2
10 Sheet2 Samle Output Sheet
Sheet2

There is an error following row. The error is "Subscript out of range"
ray(c, 1) = Dn: ray(c, 2) = Dn(, 2): ray(c, 3) = Dn(, 3): ray(c, Col) = Dn(, 5):

MickG · Jun 19, 2011

Try this , First on the data in your last post.

Code:

[COLOR=navy]Sub[/COLOR] MG19Jun06
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Room [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Col [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] nRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] nRay
[COLOR=navy]Set[/COLOR] Rng = Range(Range("B4"), Range("B" & rows.Count).End(xlUp))
 [COLOR=navy]Set[/COLOR] nRng = Rng.Offset(, 3)
   nRay = oRms(nRng)
     Range("K1").Resize(UBound(nRay)) = nRay
       ReDim Ray(1 To Rng.Count, 1 To UBound(nRay) + 5)
         Ray(1, 1) = "Row" & chr(10) & "Number"
           Ray(1, 2) = "Stock" & chr(10) & "Number"
             Ray(1, 3) = "Product"
               Ray(1, 4) = "Units"
[COLOR=navy]For[/COLOR] n = 1 To UBound(nRay)
    Ray(1, n + 4) = nRay(n, 1)
[COLOR=navy]Next[/COLOR] n
Ray(1, UBound(nRay) + 5) = "Sum"
c = 1
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
[COLOR=navy]If[/COLOR] Dn <> "" And Dn(, 4) <> "" [COLOR=navy]Then[/COLOR]
    [COLOR=navy]For[/COLOR] n = 1 To UBound(nRay)
        [COLOR=navy]If[/COLOR] nRay(n, 1) = Dn(, 4) [COLOR=navy]Then[/COLOR] Col = n + 4: [COLOR=navy]Exit[/COLOR] For
    [COLOR=navy]Next[/COLOR] n
        c = c + 1
       Ray(c, 1) = Dn.Offset(, -1): Ray(c, 2) = Dn: Ray(c, 3) = Dn(, 2): Ray(c, 4) = Dn(, 3): Ray(c, Col) = Dn(, 5):
       [COLOR=navy]If[/COLOR] Dn(, 6) <> "" [COLOR=navy]Then[/COLOR] Ray(c, UBound(Ray, 2)) = Dn(, 6)
[COLOR=navy]ElseIf[/COLOR] Dn = "" And Dn(, 4) <> "" [COLOR=navy]Then[/COLOR]
    [COLOR=navy]For[/COLOR] n = 1 To UBound(nRay)
        [COLOR=navy]If[/COLOR] nRay(n, 1) = Dn(, 4) [COLOR=navy]Then[/COLOR] Col = n + 4: [COLOR=navy]Exit[/COLOR] For
    [COLOR=navy]Next[/COLOR] n
        Ray(c, Col) = Dn(, 5)
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
Sheets("sheet2").Range("A1").Resize(c, UBound(Ray, 2)) = Ray
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Function oRms(Rng [COLOR=navy]As[/COLOR] Range) [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] i, j, Temp
[COLOR=navy]Dim[/COLOR] Ray
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Dn <> "" And Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
        .Add Dn.value, n
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Ray = .keys
[COLOR=navy]For[/COLOR] i = 0 To UBound(Ray)
    [COLOR=navy]For[/COLOR] j = i To UBound(Ray)
        [COLOR=navy]If[/COLOR] Ray(j) < Ray(i) [COLOR=navy]Then[/COLOR]
            Temp = Ray(i)
            Ray(i) = Ray(j)
            Ray(j) = Temp
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] j
[COLOR=navy]Next[/COLOR] i
oRms = Application.Transpose(Ray)
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] Function

Regards Mick

elektor · Jun 19, 2011

Any help?

MickG · Jun 19, 2011

NB:-Near the top of the code there is a line as below.
You do not need that line , I put it in for testing, Please remove.

Code:

Range("K1").Resize(UBound(nRay)) = nRay

elektor · Jun 19, 2011

Thanks MickG. This is an incredible macro. Works perfectly. Again and again thank you.

elektor · Jun 20, 2011

I have a problem. When the rooms are unique ( i.e. if there is only one kind of room, for example R05) the macro gives an error.

I get the following error
Run-time error ‘9’
Subscript out of range

on this line.
Ray(1, n + 4) = nRay(n, 1)
Could you fix this.

Transpose and sort columns in to rows

elektor

New Member

Excel Facts

MickG

MrExcel MVP

elektor

New Member

MickG

MrExcel MVP

elektor

New Member

MickG

MrExcel MVP

elektor

New Member

MickG

MrExcel MVP

elektor

New Member

elektor

New Member

Similar threads

Forum statistics

Share this page

Transpose and sort columns in to rows

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock