converting output from columns and adding fields to existing row.

[tinker11]

I have a po file with three columns - part no, due date and qty due in column form. I need to change output to have the part number in column 1, then followed by first po due date, first po qty, second po due date second po qty. on attached file, top half is what my output looks like from a pivot table. (can be changed to vba if needed)..the highlighted green cells on the bottom half is what I need to produce.
I don't need to use a pivot, all help is really appreciated.

 

[Dossfm0q]

what about?

converting output from columns and adding fields to existing row.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Part No.	Due date	# PO Qty Open
2	9892	02/03/2021	4500
3	9892	02/19/2021	360
4	9892	02/19/2021	3000
5	9892	02/21/2021	7020
6	9892	03/01/2021	4620
7	9892	04/01/2021	10020
8	9892	04/22/2021	2040
9	9892	10/01/2021	5280
10	68096	03/01/2021	800
11	68096	03/01/2021	1000
12	68096	03/01/2021	2500
13	68096	04/01/2021	2500
14	68096	04/22/2021	800
15	68096	04/22/2021	100
16
17
18
19	Part No.	1st PO Date	1st PO Qty	2nd PO Date	2nd PO Qty	3rd PO Date	3rd PO Qty	4th PO Date	4th PO Qty	5th PO Date	5th PO Qty	6th PO Date	6th PO Qty	7th PO Date	7th PO Qty	8th PO Date	8th PO Qty
20	9892	02/03/2021	4500	02/19/2021	360	02/19/2021	3000	02/21/2021	7020	03/01/2021	4620	04/01/2021	10020	04/22/2021	2040	10/01/2021	5280
21	68096	03/01/2021	800	03/01/2021	1000	03/01/2021	2500	04/01/2021	2500	04/22/2021	800	04/22/2021	100
22
ورقة1

Cell Formulas
Range	Formula
A20:A21	A20	=IFERROR(INDEX($A$2:$A$15,AGGREGATE(15,6,((ROW($A$2:$A$15)-ROW($A$2)+1)/(--(MATCH($A$2:$A$15,$A$2:$A$15,0)=(ROW($A$2:$A$15)-ROW($A$2)+1)))),COUNTA($A$19:A19)+0)),"")
B20:B21,T20:T21,R20:R21,P20:P21,N20:N21,L20:L21,J20:J21,H20:H21,F20:F21,D20:D21	B20	=IF(CEILING(COLUMNS($B$20:B20),2)/2<=COUNTIF($A$2:$A$15,$A20),TEXT(INDEX($B$2:$B$15,AGGREGATE(15,6,(ROW($A$2:$A$15)-ROW($A$2)+1)/($A$2:$A$15=$A20),1)-1+MOD((CEILING(COLUMNS($B$20:B20),2)/2)-1,COUNTIF($A$2:$A$15,$A20))+1),"mm/dd/yyyy"),"")
C20:C21,S20:S21,Q20:Q21,O20:O21,M20:M21,K20:K21,I20:I21,G20:G21,E20:E21	C20	=IF(CEILING(COLUMNS($B$20:B20),2)/2<=COUNTIF($A$2:$A$15,$A20),INDEX($C$2:$C$15,AGGREGATE(15,6,(ROW($A$2:$A$15)-ROW($A$2)+1)/($A$2:$A$15=$A20),1)-1+MOD((CEILING(COLUMNS($B$20:C20),2)/2)-1,COUNTIF($A$2:$A$15,$A20))+1),"")

 

[tinker11]

i will try this. so their could be hundreds of line items in the input file - would I copy this a20 out to final records. or could this be modified to read all inputs and proceed with formula?
my input file current has 1809 line items...changes daily.

 

[Dossfm0q]

Please go through Mr: Fluff VBA Way I think it the bet way for Huge date

Transpose every x amount of columns to rows, keeping cell of first column on each row

What I try to achieve is to convert my rows to columns, but a bit different that mostly done It has to be chopped in to 3 or 4 columns that has to be moved to a row on a new sheet, but each row needs to has to start with the first cell of the original row. Hard to explane but I think these...

www.mrexcel.com

 

[tinker11]

thank you again !! i'll try this one....

 

[tinker11]

I looked at this and don't know to convert code to my needs (vba is not my strong suit ! )

 

[Dossfm0q]

Try This

Sub Test()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
  
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2' ' Name sheet as you want  and range
   ReDim Nary(1 To 3, 1 To UBound(Ary) * UBound(Ary, 2))
   On Error Resume Next
    rn = 0
   For r = 2 To UBound(Ary)
      For c = 1 To 3
    
         If Ary(r, c) <> "" Then
        
            If c = 1 And InStr(1, Nary(nr, 1), Ary(r, 1), vbTextCompare) = 0 Then
             nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            nc = 0
            If nr > 1 Then rn = rn + 1 'Reest Row starting Num 'newline
            
            ElseIf c > 1 Then
           If c = 2 Then
           nc = nc + 1
           Nary(rn + c - 1, nc + 1) = Application.Text(CDbl(Ary(r, c)), "mm/dd/yyy")
          
           Else
            nc = nc + 1
           Nary(rn + c - 2, nc + 1) = Ary(r, c)
          
            End If
            If nc > MaxNC Then MaxNC = nc
            
            End If
         End If
      Next c
   Next r
 
   Sheets("sheet4").Cells.Clear
   Sheets("sheet2").Range("A2").Resize(nr, MaxNC).Value = Nary' ' Name the sheet as you want and range
End Sub

Book1
	A	B	C
1	Part No.	Due date	# PO Qty Open
2	9892	2/3/2021	4500
3	9892	2/19/2021	360
4	9892	2/19/2021	3000
5	9892	2/21/2021	7020
6	9892	3/1/2021	4620
7	9892	4/1/2021	10020
8	9892	4/22/2021	2040
9	9892	10/1/2021	5280
10	68096	3/1/2021	800
11	68096	3/1/2021	1000
12	68096	3/1/2021	2500
13	68096	4/1/2021	2500
14	68096	4/22/2021	800
15	68096	4/22/2021	100
16	68097	4/22/2021	200
17	68097	4/22/2021	300
18	68097	4/22/2021	400
19	68097	4/22/2021	500
20	68097	4/22/2021	600
21	68097	4/22/2021	700
22	68097	4/22/2021	800
23	68097	4/22/2021	900
24	68097	4/22/2021	1000
25	68097	4/22/2021	1100
26	68097	4/22/2021	1200
27	68097	4/22/2021	1300
28	68097	4/22/2021	1400
Sheet3

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1
2	9892	2/3/2021	4500	2/19/2021	360	2/19/2021	3000	2/21/2021	7020	3/1/2021	4620	4/1/2021	10020	4/22/2021	2040	10/1/2021	5280
3	68096	3/1/2021	800	3/1/2021	1000	3/1/2021	2500	4/1/2021	2500	4/22/2021	800	4/22/2021	100
4	68097	4/22/2021	200	4/22/2021	300	4/22/2021	400	4/22/2021	500	4/22/2021	600	4/22/2021	700	4/22/2021	800	4/22/2021	900	4/22/2021	1000	4/22/2021	1100	4/22/2021	1200	4/22/2021	1300	4/22/2021
5
Sheet4

 

[Dossfm0q]

try this

Sub converting_output_from_columns_and_adding_fields_to_existing_row()

  
   Dim Rng As Range
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
   Dim CV As String, PV As String
   Set Rng = Sheets("Sheet1").Range("A1").CurrentRegion
   Ary = Rng.Value2
   ReDim Nary(1 To 10, 1 To UBound(Ary) * UBound(Ary, 2))
   nr = 2
    nc = 1
   For r = 2 To UBound(Ary)
      For c = 1 To 3
        CV = Ary(r, c) 'Get Current Value
        If c = 1 And PV <> "" And PV <> CV Then nr = nr + 1: nc = 1 'Update rows "nr": Reset Columns
            nc = nc + 1 ' Update Columns
            Nary(nr, nc) = CV
        If c = 1 Then nc = nc - 1: PV = CV  'Get previous Value
        If nc > Maxc Then Maxc = nc ' Get Maxumum nc range
      Next c
   Next r
   '''''''''''''''''''''''''''''''''''''' Basic ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   'Sheets("sheet1").Range("A20").Resize(nr, Maxc).Value = Nary

   '''''''''''''''''''''''''''''''''''''' Advance ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Nary(1, 1) = Ary(1, 1): Nary(1, 2) = "1st PO" & Chr(10) & "Date": Nary(1, 3) = "1st PO" & Chr(10) & "Qty"
    With Sheets("sheet1")
        With .Range("A20")
        .Resize(nr, Maxc).Value = Nary ' Create New Horizintal Tble
        .Resize(1, 3).Interior.Color = Rng.Cells(1, 1).Interior.Color ' Header Color
        .Offset(0, 1).Resize(1, 2).AutoFill Destination:=.Offset(0, 1).Resize(1, Maxc) ' Fill out Header
        .CurrentRegion.Borders.LineStyle = 1 'New Tbl Borders
        End With
    End With
End Sub

or

Sub converting_output_from_columns_and_adding_fields_to_existing_row()

   Dim Rng As Range
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
   Dim CV As String, PV As String
   Set Rng = Sheets("Sheet1").Range("A1").CurrentRegion
   Ary = Rng.Value2
   ReDim Nary(1 To 10, 1 To UBound(Ary) * UBound(Ary, 2))
   nr = 2
    nc = 1
   For r = 2 To UBound(Ary)
      For c = 1 To 3
        CV = Ary(r, c) 'Get Current Value
        If c = 1 And PV <> "" And PV <> CV Then nr = nr + 1: nc = 1 'Update rows "nr": Reset Columns
            nc = nc + 1 ' Update Columns
            Nary(nr, nc) = CV
        If c = 1 Then nc = nc - 1: PV = CV  'Get previous Value
        If nc > Maxc Then Maxc = nc ' Get Maxumum nc range
      Next c
   Next r
   Sheets("sheet1").Range("A20").Resize(nr, Maxc).Value = Nary


End Sub

Book1
	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y
20	2nd PO Date	2nd PO Qty	3rd PO Date	3rd PO Qty	4th PO Date	4th PO Qty	5th PO Date	5th PO Qty	6th PO Date	6th PO Qty	7th PO Date	7th PO Qty	8th PO Date	8th PO Qty	9th PO Date	9th PO Qty	10th PO Date	10th PO Qty	11th PO Date	11th PO Qty	12th PO Date	12th PO Qty
21	9892	44246	360	9892	44246	3000	9892	44248	7020	9892	44256	4620	9892	44287	10020	9892	44308	2040	9892	44470	5280
22	68096	44256	1000	68096	44256	2500	68096	44287	2500	68096	44308	800	68096	44308	100
Sheet1

 

[Dossfm0q]

sorry missing Line "Nary(nr, 1) = CV"

            Nary(nr, nc) = CV
            Nary(nr, 1) = CV
        If c = 1 Then nc = nc - 1: PV = CV  'Get previous Value

 

[tinker11]

still getting runtime error 9 subscript out of range error
CV = Ary(r, c) 'Get Current Value
If c = 1 And PV <> "" And PV <> CV Then nr = nr + 1: nc = 1 'Update rows "nr": Reset Columns
nc = nc + 1 ' Update Columns
Nary(nr, nc) = CV
Nary(nr, 1) = CV
If c = 1 Then nc = nc - 1: PV = CV 'Get previous Value
If nc > Maxc Then Maxc = nc ' Get Maxumum nc range
Next c
Next r
Sheets("sheet1").Range("A20").Resize(nr, Maxc).Value = Nary