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.

 

[Peter_SSs]

still getting runtime error 9 subscript out of range error

On what line of code? (Click 'Debug' when the error occurs)

Does the same thing happen with this slightly modified version?

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, Rw As Long, Col As Long, maxcols As Long
  
  a = Range("A1", Range("C" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To UBound(a) * 2 + 1)
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      Rw = Rw + 1
      b(Rw, 1) = a(i, 1)
      Col = 2
    End If
    b(Rw, Col) = a(i, 2)
    b(Rw, Col + 1) = a(i, 3)
    If Col > maxcols Then maxcols = Col + 1
    Col = Col + 2
  Next i
  With Range("A" & Rows.Count).End(xlUp).Offset(3)
    .Resize(, 3).Value = Array("", "1st PO.", "1st PO..")
    .Offset(0, 1).Resize(1, 2).AutoFill Destination:=.Offset(0, 1).Resize(1, maxcols)
    .EntireRow.Replace What:=".", Replacement:="", LookAt:=xlPart
    .Offset(1).Resize(, 3).Value = Array("part no.", "Date", "Qty")
    .Offset(1, 1).Resize(1, 2).AutoFill Destination:=.Offset(1, 1).Resize(1, maxcols)
    .Offset(2).Resize(Rw, maxcols).Value = b
    .CurrentRegion.Columns.AutoFit
  End With
End Sub

 

[Dossfm0q]

Get sure if sheet name
Sheets("Sheet1") change the name as your sheet

 

[Dossfm0q]

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
   Set Rng = ActiveSheet.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 = 2 Then Nary(nr, nc) = Application.Text(CV, "MM/DD/YYY")
            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
   '''''''''''''''''''''''''''''''''''''' Basic ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ' 'Sheets("sheet1").Range("A20").Resize(nr, Maxc).Value = Nary
  ' ActiveSheet.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 ActiveSheet
        With .Range("A30")
        With .Resize(nr, Maxc)
        .Value = Nary ' Create New Horizintal Tble
        '.EntireColumn.AutoFit
        End With
        .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 - 1) ' Fill out Header
        .CurrentRegion.Borders.LineStyle = 1 'New Tbl Borders
        End With
    End With
End Sub

 

[tinker11]

that modification worked ~!! thank you.