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:-

[COLOR=navy]Sub[/COLOR] MG14Oct28
[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).Value
            Ray(3, c) = Dn.Offset(, Ac).Value * Dn.Offset(, 2).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] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[lee2121]

Perfect works great, nice bit of code thank you Mick.

 

[MickG]

You're welcome

 

[lee2121]

Hi Mick

I wonder if you wouldn't mind helping me again.

We have been using the file with much success but now we have identified that we need an extra column adding which is present in the original. The column named "Variety" needs to be inserted between "Article code" and "tray count" i have tried to change your array but i'm struggling to get this to work.

Thank you.

 

[MickG]

Try this:-
For Results to contain "Variety" column.

[COLOR="Navy"]Sub[/COLOR] MG07Nov51
[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 5, 1 To c)
            Ray(1, c) = Dn.Value
            Ray(2, c) = Dn.Offset(, 1).Value
            Ray(3, c) = Dn.Offset(, 2).Value
            Ray(4, c) = Dn.Offset(, Ac).Value * Dn.Offset(, 2).Value
            Ray(5, 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) = "Variety": Ray(3, 1) = "Tray Count"
Ray(4, 1) = "Qty": Ray(5, 1) = "Week"

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 5)
    .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]

As always perfect!

thank you so much.

 

[MickG]

You're welcome

 

[lee2121]

Hi Mick

I have come across a small issue the array seems to be missing one column, i have looked but have no knowledge of arrays and cannot figure it out please see below;

the array seems to be missing the values highlighted in column E

This is what the array outputs.

 

[MickG]

Try changing the 5 to a 4 as below:-

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

 

[lee2121]

That did the trick, yet again thank you very much and have a nice weekend!!