Rearrange data in excel

Closed
nickname - Oct 28, 2010 at 06:25 PM
venkat1926 Posts 1864 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Oct 29, 2010 at 06:17 AM
Hi,
I have a spread sheet of data that's imported from an xml file that I need to re-arrange.
Ex:
A B C D
apple 1 yellow sweet
apple 2 red sweet
apple 3 green tart
orange 4 big sweet
orange 5 small tart
pear 6 red sweet
pear 7 yellow sweet
pear 8 green tart
pear 9 brown tart

I need to re arrange it to something like this:
apple
1 yellow sweet
2 red sweet
3 green tart

orange
4 big sweet
5 small tart

pear
6 red sweet
7 yellow sweet
8 green tart
9 brown tart

Is there a way to do this automatically? How can I create a micro for future changes?
Thanks so much!

1 reply

venkat1926 Posts 1864 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 810
Oct 29, 2010 at 06:17 AM
1. introduce first row as column heading
the data will be like this

fruit no. color taste
apple 1 yellow sweet
apple 2 red sweet
apple 3 green tart
orange 4 big sweet
orange 5 small tart
pear 6 red sweet
pear 7 yellow sweet
pear 8 green tart
pear 9 brown tart

now run this macro test and see sheet2
Sub test()
Dim r As Range, rfilt As Range, cf As Range
Dim cfind As Range, add As String, dest As Range
Worksheets("sheet2").Cells.Clear
Worksheets("sheet1").Activate
Set r = Range(Range("A1"), Range("A1").End(xlDown))
Set rfilt = Range("A1").End(xlDown).Offset(5, 0)
r.AdvancedFilter action:=xlFilterCopy, copytorange:=rfilt, unique:=True
Set rfilt = Range(rfilt.Offset(1, 0), rfilt.End(xlDown))
For Each cf In rfilt
Set cfind = r.Cells.Find(what:=cf.Value, lookat:=xlWhole)
'MsgBox cfind.Address
If Not cfind Is Nothing Then
add = cfind.Address
Set dest = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest = cfind.Value
Range(cfind.Offset(0, 1), cfind.End(xlToRight)).Copy dest.Offset(1, 0)
End If
Do
Set cfind = r.Cells.FindNext(cfind)
If cfind Is Nothing Then Exit Do
If cfind.Address = add Then Exit Do
'MsgBox cfind.Address
Set dest = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Range(cfind.Offset(0, 1), cfind.End(xlToRight)).Copy dest
Loop
Next cf
End Sub
0