Transpose Data In Columns

[parscon]

Hi , I have VBA that do the Data on Column A that they Separate by | and Transport to next column with the same data in B Column . and it is working fine now just need also repeat till F column. Please check the below image you will understand better .

Question.jpg

Sub blah()
lr = Cells(Rows.Count, 1).End(xlUp).Row
SceVals = Range(Cells(1), Cells(lr, 2)).Value
For i = 1 To lr
  ExtraRowsNeeded = ExtraRowsNeeded + (Len(SceVals(i, 1)) - Len(Replace(SceVals(i, 1), "|", "", 1, , vbTextCompare)))
Next i
ReDim myresults(1 To lr + ExtraRowsNeeded, 1 To 2)
DestRow = 0
For i = 1 To lr
  x = Split(SceVals(i, 1), "|")
  For j = 0 To UBound(x)
    DestRow = DestRow + 1
    myresults(DestRow, 1) = x(j)
    myresults(DestRow, 2) = SceVals(i, 2)
  Next j
Next i
Sheets("Sheet2").Cells(1).Resize(UBound(myresults), 2).Value = myresults
End Sub

[snb]

Sub M_snb()
  sn=sheet1.cells(4,1).currentregion

  with createobject("scripting.dictionary")
    for j=2 to ubound(sn)
      st=split(sn(j,1),"|")
      for jj=0 to ubound(jj)
        .item(.count)=array(st(jj),sn(j,2),sn(j,3),sn(j,4))
      next

      sheet1.cells(1,10).resize(.count)=application.index(.items,0,0)
   next
  end with
End Sub

[p45cal]

Dead easy in Power Query:

let
    Source = Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
    SplitColumnbyDelimiter = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Hdr1", Splitter.SplitTextByDelimiter("|", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Hdr1")
in
    SplitColumnbyDelimiter

2021-02-19_103954.jpg

…but in the same vein as before:

Sub blah2()
myWidth = 4 'adjust
lr = Cells(Rows.Count, 1).End(xlUp).Row
SceVals = Range(Cells(1), Cells(lr, myWidth)).Value
For i = 1 To lr
  ExtraRowsNeeded = ExtraRowsNeeded + (Len(SceVals(i, 1)) - Len(Replace(SceVals(i, 1), "|", "", 1, , vbTextCompare)))
Next i
ReDim myresults(1 To lr + ExtraRowsNeeded, 1 To myWidth)
DestRow = 0
For i = 1 To lr
  x = Split(SceVals(i, 1), "|")
  For j = 0 To UBound(x)
    DestRow = DestRow + 1
    myresults(DestRow, 1) = x(j)
    For k = 2 To myWidth
      myresults(DestRow, k) = SceVals(i, k)
    Next k
  Next j
Next i
Sheets("Sheet2").Cells(1).Resize(UBound(myresults), myWidth).Value = myresults
End Sub

but note that your picture shows data to column D but your narrative suggests to column F; adjust the line myWidth = 4 to accommodate.

[parscon]

Thanks for your help by i need result in sheet 2 i attached the Excel File . could you please check it .

[snb]

Where did you get the first Code from ?

[p45cal]

Button on Sheet1 at cell F1 uses the macro blah2 to populate Sheet2
Right click on the table in Sheet3 and choose Refresh to update the query which uses the data from Sheet1

[parscon]

Really Good Job Man , You saved me !

[mancubus]

...

[mancubus]

Where did you get the first Code from ?

http://www.vbaexpress.com/forum/show...ata-In-Columns

OP's another thread.