Rearrange data in excel
Closed
nickname
-
Oct 28, 2010 at 06:25 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Oct 29, 2010 at 06:17 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Oct 29, 2010 at 06:17 AM
Related:
- Rearrange data in excel
- Transfer data from one excel worksheet to another automatically - Guide
- Number to words in excel - Guide
- Tmobile data check - Guide
- Gif in excel - Guide
- Marksheet in excel - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Oct 29, 2010 at 06:17 AM
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
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
