Sort Data in two columns to rows

kanta

New member
Joined
Jul 1, 2015
Messages
3
Reaction score
0
Points
0
Hi,

I have a set of data something like below. But its a huge data though.

Please see the input below..


S71

A06-15789-000

A03-52458-002

S89

A05-15789-000

A08-57778-002

A09-57785-003




Please see the output below... All the sets populated horizontally.

S71

S89

A06-15789-000

A05-15789-000

A03-52458-002

A05-15789-000

A09-57785-003




Thanks a lot for your kind attention and any help is greatly appreciated..
 
kanta/krishnakashyap, you seem to have cross posted this question at http://www.mrexcel.com/forum/excel-questions/865138-sort-data-two-columns-single-row.html

Cross posting is OK if you tell people everywhere you have cross posted to, at all the sites involved.
Please have a read of http://www.excelguru.ca/content.php?184
Ultimately it's to your benefit.

I have prepared a small macro which may solve your problem. I will post it here when you have updated related thread(s) at other forum(s). (You may have difficulty posting links since you don't have many posts at the other site(s) but if you omit the http:// part of a link you should be able to do this.)

If you leave another message in this thread I'll be alerted automatically with an email straightaway which will prompt me to reply again.
 
I have updated the related thread at other forum stating that I have cross posted in this forum. Thanks for letting me do that. Would look forward for the macro that you have created.

Thanks again.
 
This macro makes some assumptions since I have no workbook with your actual data in it. It creates a new sheet with the rearranged data:
Code:
Sub blah()
Set SourceSht = ActiveSheet
Set newsht = Sheets.Add(After:=Sheets(Sheets.Count))
LastRow = SourceSht.Cells(SourceSht.Rows.Count, "B").End(xlUp).Row
With SourceSht.Cells(1).Resize(LastRow)
  Set Headers = .SpecialCells(xlCellTypeConstants, 23)
  Headers.Copy
  newsht.Cells(1).PasteSpecial Transpose:=True
  colm = 1
  For Each cll In Headers.Cells
    ofst = 1
    Do Until Len(Application.Trim(cll.Offset(ofst).Value)) > 0 Or cll.Offset(ofst).Row > LastRow
      ofst = ofst + 1
    Loop
    Range(cll, cll.Offset(ofst - 1)).Offset(, 1).Copy newsht.Cells(2, colm)
    colm = colm + 1
  Next cll
End With
End Sub
 
Different approach with array formua, 2 different color 2 different formula.......


regards
 

Attachments

  • Example.xlsx
    10.7 KB · Views: 11
Thanks a lot p45cal and Rizky. Appreciate your help!! :wave:
 
Back
Top