Transpose Data

[lee2121]

Hi I have a sheet which will contain a qty in any of a number of columns which i need the data transposing where there is a value. This is what the sheet will look like before the transpose,

I then want it to find the data and put it int a sheet or new workbook like the images below;

Any help would be appreciated.

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG06Oct41
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, RngAc [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray() [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
 Lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
  [COLOR="Navy"]If[/COLOR] Lst > 4 [COLOR="Navy"]Then[/COLOR]
      [COLOR="Navy"]For[/COLOR] Ac = 5 To Lst
         [COLOR="Navy"]If[/COLOR] Dn.Offset(, Ac).Value <> "" [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            ReDim Preserve Ray(1 To 4, 1 To c)
            Ray(1, c) = Dn.Value
            Ray(2, c) = Dn.Offset(, 2)
            Ray(3, c) = Cells(1, Ac + 1)
            Ray(4, c) = Dn.Offset(, Ac).Value
        [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Ray(1, 1) = "Artiicle Code": Ray(2, 1) = "Tray Count": Ray(3, 1) = "Week": Ray(4, 1) = "Qty"
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
    .Value = Application.Transpose(Ray)
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[lee2121]

Try this for results on sheet2.

[COLOR=Navy]Sub[/COLOR] MG06Oct41
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, RngAc [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ray() [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
c = 1
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
 Lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
  [COLOR=Navy]If[/COLOR] Lst > 4 [COLOR=Navy]Then[/COLOR]
      [COLOR=Navy]For[/COLOR] Ac = 5 To Lst
         [COLOR=Navy]If[/COLOR] Dn.Offset(, Ac).Value <> "" [COLOR=Navy]Then[/COLOR]
            c = c + 1
            ReDim Preserve Ray(1 To 4, 1 To c)
            Ray(1, c) = Dn.Value
            Ray(2, c) = Dn.Offset(, 2)
            Ray(3, c) = Cells(1, Ac + 1)
            Ray(4, c) = Dn.Offset(, Ac).Value
        [COLOR=Navy]End[/COLOR] If
      [COLOR=Navy]Next[/COLOR] Ac
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
Ray(1, 1) = "Artiicle Code": Ray(2, 1) = "Tray Count": Ray(3, 1) = "Week": Ray(4, 1) = "Qty"
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
    .Value = Application.Transpose(Ray)
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Thanks Mick

Works great but i need it to include column E it seems to start with column F how can i change this please?

 

[MickG]

Try changing the 5 to a 4 as below:-

For Ac = [B][COLOR=#FF0000]4 [/COLOR][/B]To Lst

 

[lee2121]

Thanks this works brilliantly.

 

[MickG]

You're welcome

 

[lee2121]

Sorry to bother you i have tried but i'm struggling to swap two columns around, i ant week to appear in column D and qty to appear in column C at the moment it is the other way around.

 

[MickG]

Try this Untested.

[COLOR=#000080]Sub[/COLOR] MG06Oct41
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, RngAc [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ray() [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
c = 1
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
 Lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
  [COLOR=navy]If[/COLOR] Lst > 4 [COLOR=navy]Then[/COLOR]
      [COLOR=navy]For[/COLOR] Ac = 5 To Lst
         [COLOR=navy]If[/COLOR] Dn.Offset(, Ac).Value <> "" [COLOR=navy]Then[/COLOR]
            c = c + 1
            ReDim Preserve Ray(1 To 4, 1 To c)
            Ray(1, c) = Dn.Value
            Ray(2, c) = Dn.Offset(, 2)
            Ray(3, c) = Dn.Offset(, Ac).Value
            Ray(4, c) = Cells(1, Ac + 1)
         [COLOR=navy]
End[/COLOR] If
      [COLOR=navy]Next[/COLOR] Ac
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
Ray(1, 1) = "Artiicle Code": Ray(2, 1) = "Tray Count": Ray(3, 1) = "Qty": Ray(4, 1) = "Week"
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
    .Value = Application.Transpose(Ray)
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

 

[lee2121]

thank you works great

 

[lee2121]

Does anyone know a way using Mick's code to do the following,

I need the result of the "qty" column to actually be the result of "tray count" * "qty"

I'm sure if this is even possible using an array?