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